This tutorial will demonstrate use of the R commands used in community detection algorithms, as introduced in Week 7’s Lecture. We will look at five possible steps in a community analysis:
Identify communities Inspect density of ties within and between communities Create a community indicator in node measures dataframe Plot network with community coloring *Compare estimated community partitions
We will introduce several different community detection algorithms:
In addition to the Florentine marriages dataset used for the examples, this tutorial includes access to the GoT marriage network and two airport networks: one is weighted based on distance between the airports (airports.geo…) and the other is weighted based on the number of flights between two airports (airports.fl…). The edge attribute is called “weight”" for the igraph networks, but has a distinct name in the statnet networks. The airport networks are not perfectly symmetric for some unknown reason, and thus read in as directed networks. There is also a network created from alliances data in Correlates of War, alliances.ig and alliances.stat.
Inspect the network attributes of the airports.fl.stat and airports.geo.stat networks. For this exercise, refer to Week 1 tutorial. This will help you get familiar with the dataset you are using.
Find network size, type (un/directed, un/weighted, bipartite) and available attributes of vertices and edges
#Find network size and type
#Find network size and type
print(alliances.stat)
## Network attributes:
## vertices = 141
## directed = FALSE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 1275
## missing edges= 0
## non-missing edges= 1275
##
## Vertex attribute names:
## vertex.names
##
## Edge attribute names not shown
print(airports.fl.stat)
## Network attributes:
## vertices = 193
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 5306
## missing edges= 0
## non-missing edges= 5306
##
## Vertex attribute names:
## vertex.names
##
## Edge attribute names not shown
print(airports.geo.stat)
## Network attributes:
## vertices = 193
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 5306
## missing edges= 0
## non-missing edges= 5306
##
## Vertex attribute names:
## vertex.names
##
## Edge attribute names not shown
print(flomarr.stat)
## Network attributes:
## vertices = 16
## directed = FALSE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges= 21
## missing edges= 0
## non-missing edges= 21
##
## Vertex attribute names:
## priorates totalties vertex.names wealth
##
## No edge attributes
print(gotmarr.stat)
## Network attributes:
## vertices = 18
## directed = FALSE
## hyper = FALSE
## loops = TRUE
## multiple = FALSE
## bipartite = FALSE
## total edges= 61
## missing edges= 0
## non-missing edges= 61
##
## Vertex attribute names:
## color region vertex.names
##
## Edge attribute names:
## weight
Inspect the dyads, triads, and component structure of the airports.fl.stat and airports.geo.stat networks. Pay attention to whether network is connected, as it affects the otions you use for closeness centrality.
#Dyad census, triad census, number and size of components, isolates. Also look at the density and transitivity values
#Dyad census, triad census, number and size of components, isolates, density and transitivity
gden(alliances.stat)
## [1] 0.1291793
gtrans(alliances.stat)
## [1] 0.9062469
igraph::components(alliances.ig)$no
## [1] 2
summary(E(alliances.ig)$weight)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 1.252 1.000 5.000
gden(airports.geo.stat)
## [1] 0.1426759
gtrans(airports.geo.stat)
## [1] 0.4270636
igraph::components(airports.geo.ig)$no
## [1] 1
summary(airports.geo.stat%e%"dist")
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 378.5 677.5 838.2 1080.0 6089.0
gden(airports.fl.stat)
## [1] 0.1426759
gtrans(airports.fl.stat)
## [1] 0.4270636
igraph::components(airports.fl.ig)$no
## [1] 1
summary(airports.fl.stat%e%"flights")
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.0 27.0 80.0 115.5 159.0 1271.0
Create a dataframe of standard, applicable node-level measures (from weeks 3-5.) See the routine developed in week 6, as well as the specialized functions for derived and reflected centrality and network brokerage.
#create dataframe with names
#add degree if undirected
#add degree.wt if weighted (and makes sense)
#else add indegree and outdegree if directed
#add sna::bompow for non-singular, unweighted matrix
#else add igraph::power_centrality()
#add betweenness, set gmode for undirected
#add closeness, set gmode for undirected and cmode if not connected
#add constraint (igraph)
#add eigenvector centrality using custom function
#add brokerage using custom func. if vertex attribute + directed
alliances.nodes<-data.frame(name=alliances.stat%v%"vertex.names",
degree=sna::degree(alliances.stat,gmode="digraph"),
degree.wt=strength(alliances.ig),
betweenness=sna::betweenness(alliances.stat, gmode="digraph"),
close=sna::closeness(alliances.stat, cmode="suminvdir"),
constraint=constraint(alliances.ig)
)
alliances.nodes<-full_join(alliances.nodes,get.eigen(alliances.stat), by="name")
airports.fl.nodes<-data.frame(name=airports.fl.stat%v%"vertex.names",
degree=sna::degree(airports.fl.stat,gmode="digraph"),
degree.wt=strength(airports.fl.ig),
betweenness=sna::betweenness(airports.fl.stat),
close=sna::closeness(airports.fl.stat, gmode="digraph"),
constraint=constraint(airports.fl.ig))
airports.fl.nodes<-full_join(airports.fl.nodes,get.eigen(airports.fl.stat), by="name")
airports.geo.nodes<- data.frame(name=airports.geo.stat%v%"vertex.names",
degree=sna::degree(airports.geo.stat,gmode="digraph"),
degree.wt=strength(airports.geo.ig),
betweenness=sna::betweenness(airports.geo.stat),
close=sna::closeness(airports.geo.stat, gmode="digraph"))
airports.geo.nodes<-full_join(airports.geo.nodes,get.eigen(airports.geo.stat), by="name")
flomarr.nodes<-data.frame(name=flomarr.stat%v%"vertex.names",
degree=sna::degree(flomarr.stat,gmode="graph"),
betweenness=sna::betweenness(flomarr.stat, gmode="graph"),
close=sna::closeness(flomarr.stat, gmode="graph"),
constraint=constraint(flomarr.ig))
flomarr.nodes<-full_join(flomarr.nodes,get.eigen(flomarr.stat), by="name")
gotmarr.nodes<-data.frame(name=gotmarr.stat%v%"vertex.names",
degree=sna::degree(gotmarr.stat,gmode="graph"),
degree.wt=strength(gotmarr.ig),
bonpow=sna::bonpow(gotmarr.stat),
betweenness=sna::betweenness(gotmarr.stat, gmode="graph"),
close=sna::closeness(gotmarr.stat, gmode="graph"),
constraint=constraint(gotmarr.ig))
gotmarr.nodes<-full_join(gotmarr.nodes,get.eigen(gotmarr.stat, "weight"), by="name")
This method tries to detect particularly dense subgraphs by optimizing modularity scores. (See http://www.arxiv.org/abs/cond-mat/0408187) It is often tried first for simplicity because it has no parameters to tune. This algorithm is part of the igraph package, and thus you must specify an igraph object. It only works on undirected graphs, or directed graphs must be converted to undirected.
#Run clustering algorithm: fast_greedy
comm.fg<-cluster_fast_greedy(flomarr.ig)
#Inspect clustering object
names(comm.fg)
## [1] "merges" "modularity" "membership" "names" "algorithm"
## [6] "vcount"
comm.fg
## IGRAPH clustering fast greedy, groups: 4, mod: 0.44
## + groups:
## $`1`
## [1] "Acciaiuoli" "Medici" "Pazzi" "Ridolfi" "Salviati"
## [6] "Tornabuoni"
##
## $`2`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
##
## $`3`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## + ... omitted several groups/vertices
As can be seen in the R output, the resulting communities object consists of a significant amount of information, including the optimzed (final) modularity score, a community membership vector, and a specification of which algorithm was used to extract communities. This allows us to compare modularity scores across different clustering algorithms, and also extract membership vectors as described below.
In order to see a complete list of which nodes belong to which clusters, we can easily retrieve this information using groups.
#retrieve list of nodes in communities
igraph::groups(comm.fg)
## $`1`
## [1] "Acciaiuoli" "Medici" "Pazzi" "Ridolfi" "Salviati"
## [6] "Tornabuoni"
##
## $`2`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
##
## $`3`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`4`
## [1] "Pucci"
Now, using one of the other networks provided this week, try running the fast, greedy algorithm to partition the network into communities and then retrieve the list of vertex names in each community. Note that if the network is directed, you will need to call the function as.undirected() in order to get this function to work.
#Run clustering algorithm: fast_greedy
#Retrieve list of nodes in communities
#Run clustering algorithm: fast_greedy
got.fg<-cluster_fast_greedy(gotmarr.ig)
#Retrieve list of nodes in communities
igraph::groups(got.fg)
## $`1`
## [1] "Arryn" "Tully" "Vale"
##
## $`2`
## [1] "Martell" "Crownlands" "Essos" "Targaryen" "Dorne"
##
## $`3`
## [1] "Baratheon" "Reach" "Tyrell"
##
## $`4`
## [1] "Stormlands" "Riverlands" "Frey"
##
## $`5`
## [1] "Lannister" "Westerlands"
##
## $`6`
## [1] "Stark" "North"
#other example networks
alliances.fg<-cluster_fast_greedy(alliances.ig)
igraph::groups(alliances.fg)
## $`1`
## [1] "Sudan" "Central African Republic"
## [3] "Chad" "Cameroon"
## [5] "Gabon" "Congo"
## [7] "Rwanda" "Kenya"
## [9] "Democratic Republic of the Congo" "Burundi"
## [11] "Uganda" "Angola"
## [13] "Ethiopia" "Sao Tome and Principe"
## [15] "Equatorial Guinea" "Tanzania"
## [17] "Zambia" "Eritrea"
##
## $`2`
## [1] "Russia" "Bulgaria" "Romania" "Iran"
## [5] "Latvia" "Albania" "Pakistan" "China"
## [9] "Afghanistan" "India" "North Korea" "Moldova"
## [13] "Ukraine" "Belarus" "Armenia" "Georgia"
## [17] "Azerbaijan" "Turkmenistan" "Tajikistan" "Kyrgyzstan"
## [21] "Uzbekistan" "Slovakia" "Lithuania" "Kazakhstan"
## [25] "Finland" "Mongolia" "South Korea"
##
## $`3`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Spain" "United States of America"
## [9] "Greece" "Turkey"
## [11] "Poland" "Estonia"
## [13] "Hungary" "Japan"
## [15] "Australia" "Canada"
## [17] "Luxembourg" "Portugal"
## [19] "German Federal Republic" "Czech Republic"
## [21] "Norway" "Denmark"
## [23] "Iceland" "Philippines"
##
## $`4`
## [1] "Yugoslavia" "Croatia"
## [3] "Bosnia and Herzegovina"
##
## $`5`
## [1] "South Africa" "Swaziland"
##
## $`6`
## [1] "Saudi Arabia" "Iraq" "Mauritania"
## [4] "Somalia" "Djibouti" "Morocco"
## [7] "Algeria" "Tunisia" "Libya"
## [10] "Egypt" "Syria" "Lebanon"
## [13] "Jordan" "Yemen" "Kuwait"
## [16] "Bahrain" "Qatar" "United Arab Emirates"
## [19] "Oman" "Israel"
##
## $`7`
## [1] "Mali" "Guinea" "Senegal" "Benin"
## [5] "Niger" "Ivory Coast" "Burkina Faso" "Togo"
## [9] "Cape Verde" "Guinea-Bissau" "Gambia" "Liberia"
## [13] "Sierra Leone" "Ghana" "Nigeria"
##
## $`8`
## [1] "Paraguay" "Brazil"
## [3] "Ecuador" "Peru"
## [5] "Colombia" "Argentina"
## [7] "Bolivia" "Guatemala"
## [9] "Honduras" "El Salvador"
## [11] "Nicaragua" "Haiti"
## [13] "Dominican Republic" "Mexico"
## [15] "Costa Rica" "Panama"
## [17] "Venezuela" "Chile"
## [19] "Bahamas" "Jamaica"
## [21] "Trinidad and Tobago" "Barbados"
## [23] "Dominica" "Grenada"
## [25] "St. Lucia" "St. Vincent and the Grenadines"
## [27] "Antigua & Barbuda" "St. Kitts and Nevis"
## [29] "Belize" "Guyana"
## [31] "Suriname" "Uruguay"
airports.fl.fg<-cluster_fast_greedy(as.undirected(airports.fl.ig))
igraph::groups(airports.fl.fg)
## $`1`
## [1] "ABQ" "ANC" "ASE" "AZA" "BET" "BIL" "BLI" "BOI" "BQN" "BUR" "BZN"
## [12] "COS" "DEN" "DRO" "EGE" "EUG" "FAI" "FAT" "GEG" "GJT" "GTF" "IDA"
## [23] "JAC" "JFK" "JNU" "KTN" "LAS" "LAX" "LGB" "MFR" "MRY" "MSO" "OAK"
## [34] "ONT" "PDX" "PHX" "PSC" "PSP" "RAP" "RDM" "RNO" "SAN" "SBA" "SEA"
## [45] "SFO" "SJC" "SLC" "SMF" "SNA" "TUS"
##
## $`2`
## [1] "GUM" "HNL" "ITO" "KOA" "LIH" "OGG"
##
## $`3`
## [1] "ABE" "ACY" "AGS" "ALB" "ATL" "AVL" "AVP" "AZO" "BDL" "BGR" "BMI"
## [12] "BNA" "BOS" "BTV" "BUF" "BWI" "CAE" "CAK" "CHA" "CHO" "CHS" "CLE"
## [23] "CLT" "CMH" "CRW" "CVG" "DAB" "DAY" "DCA" "DTW" "ECP" "ELM" "EVV"
## [34] "EWR" "EYW" "FAY" "FLL" "FNT" "FWA" "GNV" "GRR" "GSO" "GSP" "HPN"
## [45] "HSV" "IAD" "ILM" "IND" "ISP" "JAX" "LEX" "LGA" "MCO" "MDT" "MDW"
## [56] "MHT" "MIA" "MKE" "MLB" "MLI" "MSN" "MYR" "OAJ" "ORD" "ORF" "PBI"
## [67] "PGD" "PHF" "PHL" "PIE" "PIT" "PVD" "PWM" "RDU" "RIC" "ROA" "ROC"
## [78] "RSW" "SAV" "SBN" "SCE" "SDF" "SRQ" "STL" "SWF" "SYR" "TLH" "TPA"
## [89] "TRI" "TYS"
##
## $`4`
## [1] "ATW" "BIS" "CID" "DSM" "FAR" "FSD" "GRB" "MSP" "OMA" "PIA" "SFB"
##
## $`5`
## [1] "AMA" "AUS" "BHM" "BTR" "CRP" "DAL" "DFW" "ELP" "GPT" "GRK" "HOU"
## [12] "HRL" "IAH" "ICT" "JAN" "LBB" "LFT" "LIT" "MAF" "MCI" "MEM" "MFE"
## [23] "MGM" "MOB" "MSY" "OKC" "PNS" "SAT" "SGF" "SHV" "TUL" "VPS" "XNA"
##
## $`6`
## [1] "SJU" "STT" "STX"
airports.geo.fg<-cluster_fast_greedy(as.undirected(airports.geo.ig))
igraph::groups(airports.geo.fg)
## $`1`
## [1] "ATL" "ATW" "AZA" "BGR" "BIL" "BIS" "BZN" "CAK" "CHO" "CID" "DEN"
## [12] "DRO" "ELM" "ELP" "EUG" "FAR" "FSD" "FWA" "GNV" "GRK" "GRR" "GTF"
## [23] "HPN" "HRL" "IDA" "JAC" "LIH" "MDT" "MFR" "MLI" "MSO" "OAJ" "PHF"
## [34] "PIA" "PIE" "PSC" "RDM" "ROA" "SBA" "SBN" "SCE" "SFB" "SGF" "STX"
## [45] "TRI" "XNA"
##
## $`2`
## [1] "ABE" "AGS" "AVL" "AVP" "AZO" "BMI" "BTR" "CAE" "CHA" "CHS" "CLT"
## [12] "CRP" "CRW" "DAB" "DAY" "DFW" "DTW" "EGE" "EVV" "EYW" "FAT" "FAY"
## [23] "GPT" "GSO" "GSP" "HSV" "IAH" "ICT" "ILM" "JAN" "LEX" "LFT" "LGA"
## [34] "LIT" "MGM" "MLB" "MOB" "MYR" "ORF" "PBI" "PGD" "PNS" "PWM" "RIC"
## [45] "SAV" "SRQ" "TLH" "TYS" "VPS"
##
## $`3`
## [1] "ABQ" "ANC" "ASE" "AUS" "BET" "BLI" "BOI" "BOS" "BQN" "BUR" "COS"
## [12] "EWR" "FAI" "GUM" "HNL" "IAD" "ITO" "JFK" "JNU" "KOA" "KTN" "LBB"
## [23] "LGB" "MAF" "MCI" "MDW" "MRY" "MSP" "OAK" "OGG" "OKC" "ONT" "ORD"
## [34] "PDX" "PSP" "RAP" "RNO" "SAN" "SAT" "SEA" "SFO" "SJC" "SLC" "SMF"
## [45] "SNA" "STL" "STT" "TUS"
##
## $`4`
## [1] "ACY" "ALB" "AMA" "BDL" "BHM" "BNA" "BTV" "BUF" "BWI" "CLE" "CMH"
## [12] "CVG" "DAL" "DCA" "DSM" "ECP" "FLL" "FNT" "GEG" "GJT" "GRB" "HOU"
## [23] "IND" "ISP" "JAX" "LAS" "LAX" "MCO" "MEM" "MFE" "MHT" "MIA" "MKE"
## [34] "MSN" "MSY" "OMA" "PHL" "PHX" "PIT" "PVD" "RDU" "ROC" "RSW" "SDF"
## [45] "SHV" "SJU" "SWF" "SYR" "TPA" "TUL"
The substantive goal of community detection is often to identify groups of nodes with a higher density of ties within communities than between communities. The easiest way to quickly calculate the density of ties within and between communities is to use the blockmodel funciton and simply provide the community membership vector in place of a clustering object.
#blockmodel with community membership
blockmodel(flomarr.stat,comm.fg$membership)
##
## Network Blockmodel:
##
## Block membership:
##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
## 1 2 3 3 3 2 2 2 1 1 3 4 1 1 3 1
##
## Reduced form blockmodel:
##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.40000000 0.08333333 0.06666667 0
## Block 2 0.08333333 0.50000000 0.05000000 0
## Block 3 0.06666667 0.05000000 0.60000000 0
## Block 4 0.00000000 0.00000000 0.00000000 NaN
#only retrieve block density object
blockmodel(flomarr.stat,comm.fg$membership)$block.model
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.40000000 0.08333333 0.06666667 0
## Block 2 0.08333333 0.50000000 0.05000000 0
## Block 3 0.06666667 0.05000000 0.60000000 0
## Block 4 0.00000000 0.00000000 0.00000000 NaN
#print block densities using only 2 digits for readability
print(blockmodel(flomarr.stat,comm.fg$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.400 0.083 0.067 0
## Block 2 0.083 0.500 0.050 0
## Block 3 0.067 0.050 0.600 0
## Block 4 0.000 0.000 0.000 NaN
Using the same network in the previous step, try using theblockmodel command to print the density of ties within and between community groups. Feel free to use only a single command that produces output you find acceptable (i.e., you only need to use one of the commands from the previous R example syntax.) Do the community clusters work as intended?
#Inspect density within and between communities
#Inspect density within and between communities
print(blockmodel(gotmarr.stat,got.fg$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6
## Block 1 1.00 0.13 0.00 0.33 0.00 0.33
## Block 2 0.13 0.60 0.20 0.33 0.20 0.20
## Block 3 0.00 0.20 1.00 0.44 0.50 0.33
## Block 4 0.33 0.33 0.44 0.67 0.33 0.33
## Block 5 0.00 0.20 0.50 0.33 1.00 0.50
## Block 6 0.33 0.20 0.33 0.33 0.50 1.00
#alliances
print(blockmodel(alliances.stat, alliances.fg$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.6405 0.0000 0.0023 0.000 0 0.0528 0.0000 0.000
## Block 2 0.0000 0.3020 0.0340 0.000 0 0.0019 0.0000 0.000
## Block 3 0.0023 0.0340 0.6667 0.014 0 0.0000 0.0028 0.083
## Block 4 0.0000 0.0000 0.0139 1.000 0 0.0000 0.0000 0.000
## Block 5 0.0000 0.0000 0.0000 0.000 1 0.0000 0.0000 0.000
## Block 6 0.0528 0.0019 0.0000 0.000 0 0.9105 0.0000 0.000
## Block 7 0.0000 0.0000 0.0028 0.000 0 0.0000 1.0000 0.000
## Block 8 0.0000 0.0000 0.0833 0.000 0 0.0000 0.0000 1.000
#airport flights
print(blockmodel(airports.fl.stat,airports.fl.fg$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6
## Block 1 0.284 0.1567 0.071 0.118 0.099 0.020
## Block 2 0.143 0.5667 0.011 0.015 0.015 0.000
## Block 3 0.072 0.0093 0.247 0.116 0.120 0.100
## Block 4 0.120 0.0152 0.115 0.300 0.085 0.061
## Block 5 0.105 0.0152 0.121 0.091 0.252 0.020
## Block 6 0.020 0.0000 0.100 0.030 0.020 1.000
#airport distance
print(blockmodel(airports.geo.stat, airports.geo.fg$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.104 0.060 0.082 0.093
## Block 2 0.065 0.151 0.085 0.143
## Block 3 0.090 0.082 0.307 0.198
## Block 4 0.094 0.146 0.199 0.360
In order to work with the community clusters produced in the initial step, it is convenient to extract the membership vector and add it into our standard network.nodes dataframe. First, let’s inspect the community memberships, comparing the results to the vertex names stored in the object and the results of the membership function.
#Inspect community membership vector
comm.fg$membership
## [1] 1 2 3 3 3 2 2 2 1 1 3 4 1 1 3 1
#Compare to vertex names vector
comm.fg$names
## [1] "Acciaiuoli" "Albizzi" "Barbadori" "Bischeri"
## [5] "Castellani" "Ginori" "Guadagni" "Lamberteschi"
## [9] "Medici" "Pazzi" "Peruzzi" "Pucci"
## [13] "Ridolfi" "Salviati" "Strozzi" "Tornabuoni"
#Membership function
membership(comm.fg)
## Acciaiuoli Albizzi Barbadori Bischeri Castellani
## 1 2 3 3 3
## Ginori Guadagni Lamberteschi Medici Pazzi
## 2 2 2 1 1
## Peruzzi Pucci Ridolfi Salviati Strozzi
## 3 4 1 1 3
## Tornabuoni
## 1
#Check order of vertex names
V(flomarr.ig)$name
## [1] "Acciaiuoli" "Albizzi" "Barbadori" "Bischeri"
## [5] "Castellani" "Ginori" "Guadagni" "Lamberteschi"
## [9] "Medici" "Pazzi" "Peruzzi" "Pucci"
## [13] "Ridolfi" "Salviati" "Strozzi" "Tornabuoni"
As can be seen in these results, the membership function provides the information in both the membership and names vector in the original vertex order. Therefore, we can add the information to the flomarr.nodes dataframe and summarize the other node statistics by community.
#add community membership as a node attribute
flomarr.nodes$comm.fg<-comm.fg$membership
#summarize node statistics by community
flomarr.nodes%>%
select(-name)%>% group_by(comm.fg)%>%
mutate(n=n())%>%
summarise_all(mean, na.rm=TRUE)%>%
as.matrix()%>%
print(digits=2)
## comm.fg degree betweenness close constraint eigen eigen.rc eigen.dc n
## [1,] 1 2.7 13.2 0 0.60 0.24 0.071 0.17 6
## [2,] 2 2.2 10.6 0 0.65 0.17 0.057 0.12 4
## [3,] 3 3.0 6.9 0 0.52 0.28 0.082 0.19 5
## [4,] 4 0.0 0.0 0 0.00 0.00 NaN NaN 1
Note that here we can tell that there are 6 nodes in community cluster 1, 4 in community cluster 2, 5 nodes in cluster 5, and only 1 node in cluster 4. What other differences do you notice between clusters?
Because we will be repeating the same steps multiple times this week, lets create a custom function to summarize the node statistics by community group.
nodes.by.gp<-function(network.nodes, groupvar){
network.nodes%>%
select(-name)%>%
group_by_(groupvar) %>%
mutate(n=n())%>%
summarise_all(mean, na.rm=TRUE)%>%
as.matrix()%>%
print(digits=2)
}
Now, we can use a single command to produce a summary table of node statistics.
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.fg")
## comm.fg degree betweenness close constraint eigen eigen.rc eigen.dc n
## [1,] 1 2.7 13.2 0 0.60 0.24 0.071 0.17 6
## [2,] 2 2.2 10.6 0 0.65 0.17 0.057 0.12 4
## [3,] 3 3.0 6.9 0 0.52 0.28 0.082 0.19 5
## [4,] 4 0.0 0.0 0 0.00 0.00 NaN NaN 1
Try adding on the community membership vector as a node attribute and summarizing node statistics by community. If you have forgotten which nodes belong to each community group, use the command provided in step 1 to retrieve node names.
#add community membership as a node attribute
#summarize node statistics by community
#retrieve list of nodes in each group (if you forgot earlier result)
#add community membership as a node attribute
gotmarr.nodes$comm.fg<-got.fg$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.fg")
## comm.fg degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 4.3 16 -1.08 1.8 0.53 0.45 0.17
## [2,] 2 5.2 22 -0.79 9.3 0.57 0.62 0.20
## [3,] 3 6.0 22 -0.96 8.9 0.59 0.45 0.22
## [4,] 4 6.7 30 -1.54 7.1 0.62 0.37 0.27
## [5,] 5 5.5 25 -0.15 1.4 0.58 0.57 0.25
## [6,] 6 6.0 36 -0.29 6.9 0.59 0.53 0.24
## eigen.rc eigen.dc n
## [1,] 0.018 0.15 3
## [2,] 0.041 0.16 5
## [3,] 0.039 0.18 3
## [4,] 0.076 0.19 3
## [5,] 0.095 0.16 2
## [6,] 0.114 0.12 2
#retrieve list of nodes in each group
igraph::groups(got.fg)
## $`1`
## [1] "Arryn" "Tully" "Vale"
##
## $`2`
## [1] "Martell" "Crownlands" "Essos" "Targaryen" "Dorne"
##
## $`3`
## [1] "Baratheon" "Reach" "Tyrell"
##
## $`4`
## [1] "Stormlands" "Riverlands" "Frey"
##
## $`5`
## [1] "Lannister" "Westerlands"
##
## $`6`
## [1] "Stark" "North"
alliances.nodes$comm.fg<-alliances.fg$membership
nodes.by.gp(alliances.nodes,"comm.fg")
## comm.fg degree degree.wt betweenness close constraint eigen
## [1,] 1 24.0 14.8 437 0.3373 0.32 5.5e-05
## [2,] 2 17.4 13.4 386 0.3707 0.38 1.5e-03
## [3,] 3 38.1 22.5 740 0.4538 0.31 3.1e-02
## [4,] 4 4.7 2.3 181 0.2741 0.88 2.3e-04
## [5,] 5 2.0 1.0 0 0.0071 1.00 7.5e-64
## [6,] 6 36.6 33.7 193 0.3440 0.22 1.5e-06
## [7,] 7 28.1 14.2 231 0.3398 0.26 6.3e-04
## [8,] 8 66.0 35.2 0 0.4809 0.12 1.7e-01
## eigen.rc eigen.dc n
## [1,] 4.0e-06 5.1e-05 18
## [2,] 9.4e-05 1.4e-03 27
## [3,] 1.3e-03 3.0e-02 24
## [4,] 2.9e-05 2.0e-04 3
## [5,] 7.5e-64 0.0e+00 2
## [6,] 7.7e-08 1.4e-06 20
## [7,] 4.1e-05 5.9e-04 15
## [8,] 5.0e-03 1.7e-01 32
airports.fl.nodes$comm.fg<-airports.fl.fg$membership
nodes.by.gp(airports.fl.nodes,"comm.fg")
## comm.fg degree degree.wt betweenness close constraint eigen eigen.rc
## [1,] 1 52 6559 216.5 0.50 0.29 0.047 0.00085
## [2,] 2 24 3320 108.4 0.44 0.58 0.022 0.00038
## [3,] 3 62 7152 204.6 0.52 0.19 0.064 0.00107
## [4,] 4 45 3664 164.0 0.51 0.22 0.044 0.00072
## [5,] 5 50 5582 158.0 0.51 0.21 0.053 0.00083
## [6,] 6 26 3210 9.4 0.48 0.50 0.033 0.00043
## eigen.dc n
## [1,] 0.046 50
## [2,] 0.022 6
## [3,] 0.063 90
## [4,] 0.043 11
## [5,] 0.052 33
## [6,] 0.033 3
airports.geo.nodes$comm.fg<-airports.geo.fg$membership
nodes.by.gp(airports.geo.nodes,"comm.fg")
## comm.fg degree degree.wt betweenness close eigen eigen.rc eigen.dc n
## [1,] 1 33 24761 165 0.48 0.030 0.00053 0.030 46
## [2,] 2 43 27571 167 0.50 0.045 0.00072 0.044 49
## [3,] 3 65 67686 239 0.51 0.062 0.00109 0.061 48
## [4,] 4 77 63125 193 0.54 0.081 0.00131 0.080 50
Igraph has a built-in function to color nodes by community that doesn’t require the researcher to add the membership vector to the network as a vertex attribute. To automatically color nodes by community membership, simply include the community object in the plotting call as follows.
#plot network with community coloring
plot(comm.fg,flomarr.ig)
Using the clustering object created in step 1, plot the network with community coloring.
#plot network with community coloring
#plot network with community coloring
plot(got.fg,gotmarr.ig)
plot(alliances.fg,alliances.ig)
plot(airports.fl.fg,airports.fl.ig)
plot(airports.geo.fg,airports.geo.ig)
This algorithm detects communities based on random walks across the network. It can handle a weights argument, which makes it a good tool for weighted networks. Higher weights increase the probability that a random walker goes in that direction vs the direction of a tie with a lower weight.
#Run clustering algorithm: walktrap
comm.wt<-walktrap.community(flomarr.ig)
#Inspect community membership
igraph::groups(comm.wt)
## $`1`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
##
## $`2`
## [1] "Acciaiuoli" "Medici" "Ridolfi" "Tornabuoni"
##
## $`3`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`4`
## [1] "Pazzi" "Salviati"
##
## $`5`
## [1] "Pucci"
The critical parameter for the walktrap method is steps=x, and the value of \(x\) can result in different community membership vectors (and also affect how long the algorithm takes to run). Let’s try with more steps. Do you have any ideas about what might be going on when we increase the number of steps?
#Run & inspect clustering algorithm: 10 steps
igraph::groups(walktrap.community(flomarr.ig, steps=10))
## $`1`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
##
## $`2`
## [1] "Acciaiuoli" "Medici" "Ridolfi" "Tornabuoni"
##
## $`3`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`4`
## [1] "Pazzi" "Salviati"
##
## $`5`
## [1] "Pucci"
#Run & inspect clustering algorithm: 20 steps
igraph::groups(walktrap.community(flomarr.ig ,steps=20))
## $`1`
## [1] "Acciaiuoli" "Albizzi" "Ginori" "Guadagni"
## [5] "Lamberteschi" "Medici" "Ridolfi" "Tornabuoni"
##
## $`2`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`3`
## [1] "Pazzi" "Salviati"
##
## $`4`
## [1] "Pucci"
#Run & inspect clustering algorithm
igraph::groups(walktrap.community(flomarr.ig, steps=100))
## $`1`
## [1] "Acciaiuoli" "Albizzi" "Barbadori" "Ginori" "Medici"
## [6] "Ridolfi" "Tornabuoni"
##
## $`2`
## [1] "Pazzi" "Salviati"
##
## $`3`
## [1] "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`4`
## [1] "Guadagni" "Lamberteschi"
##
## $`5`
## [1] "Pucci"
The community object can be used in the various steps introduced earlier. Lets inspect density of ties within and between communities, and the characteristics of nodes in each community.
#inspect density of between/within community ties
print(blockmodel(flomarr.stat,comm.wt$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.50 0.12 0.05 0.00 0
## Block 2 0.12 0.67 0.10 0.12 0
## Block 3 0.05 0.10 0.60 0.00 0
## Block 4 0.00 0.12 0.00 1.00 0
## Block 5 0.00 0.00 0.00 0.00 NaN
#add community membership as a vertex attribute
flomarr.nodes$comm.wt<-comm.wt$membership
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.wt")
## comm.wt degree betweenness close constraint eigen eigen.rc eigen.dc
## [1,] 1 2.2 10.6 0 0.65 0.174 0.057 0.117
## [2,] 2 3.2 16.5 0 0.53 0.307 0.090 0.217
## [3,] 3 3.0 6.9 0 0.52 0.277 0.082 0.195
## [4,] 4 1.5 6.5 0 0.75 0.095 0.032 0.063
## [5,] 5 0.0 0.0 0 0.00 0.000 NaN NaN
## comm.fg n
## [1,] 2 4
## [2,] 1 4
## [3,] 3 5
## [4,] 1 2
## [5,] 4 1
Finally, lets try plotting the network with walktrap community coloring.
#plot network with community coloring
plot(comm.wt,flomarr.ig)
Repeat all of the above steps for one of the other datasets provided this week.
#Run clustering algorithm: walktrap
#Inspect community membership
#Optional: Experiment with steps option
#inspect density of between/within community ties
#add community membership as a vertex attribute
#summarize node statistics by community
#plot the network with community coloring
#Run clustering algorithm: walktrap
got.wt<-walktrap.community(gotmarr.ig)
#Inspect community membership
igraph::groups(got.wt)
## $`1`
## [1] "Arryn" "Tully" "Vale" "Stormlands" "Riverlands"
## [6] "Frey"
##
## $`2`
## [1] "Martell" "Crownlands" "Essos" "Targaryen" "Dorne"
##
## $`3`
## [1] "Baratheon" "Reach" "Tyrell"
##
## $`4`
## [1] "Stark" "North"
##
## $`5`
## [1] "Lannister" "Westerlands"
#inspect density of between/within community ties
print(blockmodel(gotmarr.stat,got.wt$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.53 0.23 0.22 0.33 0.17
## Block 2 0.23 0.60 0.20 0.20 0.20
## Block 3 0.22 0.20 1.00 0.33 0.50
## Block 4 0.33 0.20 0.33 1.00 0.50
## Block 5 0.17 0.20 0.50 0.50 1.00
#add community membership as a vertex attribute
gotmarr.nodes$comm.wt<-got.wt$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.wt")
## comm.wt degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 5.5 23 -1.31 4.5 0.58 0.41 0.22
## [2,] 2 5.2 22 -0.79 9.3 0.57 0.62 0.20
## [3,] 3 6.0 22 -0.96 8.9 0.59 0.45 0.22
## [4,] 4 6.0 36 -0.29 6.9 0.59 0.53 0.24
## [5,] 5 5.5 25 -0.15 1.4 0.58 0.57 0.25
## eigen.rc eigen.dc comm.fg n
## [1,] 0.047 0.17 2.5 6
## [2,] 0.041 0.16 2.0 5
## [3,] 0.039 0.18 3.0 3
## [4,] 0.114 0.12 6.0 2
## [5,] 0.095 0.16 5.0 2
#plot the network with community coloring
plot(got.wt,gotmarr.ig)
alliances.wt<-walktrap.community(alliances.ig)
igraph::groups(alliances.wt)
## $`1`
## [1] "Russia" "Iran" "Latvia" "Pakistan"
## [5] "China" "Afghanistan" "India" "North Korea"
## [9] "Moldova" "Ukraine" "Belarus" "Armenia"
## [13] "Georgia" "Azerbaijan" "Turkmenistan" "Tajikistan"
## [17] "Kyrgyzstan" "Uzbekistan" "Lithuania" "Kazakhstan"
## [21] "Finland" "Mongolia" "South Korea"
##
## $`2`
## [1] "Ethiopia" "Eritrea"
##
## $`3`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Spain" "Greece"
## [9] "Bulgaria" "Romania"
## [11] "Turkey" "Poland"
## [13] "Estonia" "Hungary"
## [15] "Albania" "Luxembourg"
## [17] "Portugal" "German Federal Republic"
## [19] "Czech Republic" "Norway"
## [21] "Denmark" "Iceland"
## [23] "Slovakia"
##
## $`4`
## [1] "Paraguay" "Brazil"
## [3] "Ecuador" "Peru"
## [5] "Colombia" "Argentina"
## [7] "Bolivia" "Guatemala"
## [9] "Honduras" "El Salvador"
## [11] "Nicaragua" "United States of America"
## [13] "Haiti" "Dominican Republic"
## [15] "Mexico" "Costa Rica"
## [17] "Panama" "Venezuela"
## [19] "Chile" "Japan"
## [21] "Australia" "Canada"
## [23] "Bahamas" "Jamaica"
## [25] "Trinidad and Tobago" "Barbados"
## [27] "Dominica" "Grenada"
## [29] "St. Lucia" "St. Vincent and the Grenadines"
## [31] "Antigua & Barbuda" "St. Kitts and Nevis"
## [33] "Belize" "Guyana"
## [35] "Suriname" "Philippines"
## [37] "Uruguay"
##
## $`5`
## [1] "Yugoslavia" "Croatia"
## [3] "Bosnia and Herzegovina"
##
## $`6`
## [1] "Central African Republic" "Chad"
## [3] "Cameroon" "Gabon"
## [5] "Congo" "Rwanda"
## [7] "Kenya" "Democratic Republic of the Congo"
## [9] "Burundi" "Uganda"
## [11] "Angola" "Sao Tome and Principe"
## [13] "Equatorial Guinea" "Tanzania"
## [15] "Zambia"
##
## $`7`
## [1] "Saudi Arabia" "Iraq" "Mauritania"
## [4] "Somalia" "Djibouti" "Morocco"
## [7] "Algeria" "Tunisia" "Libya"
## [10] "Sudan" "Egypt" "Syria"
## [13] "Lebanon" "Jordan" "Yemen"
## [16] "Kuwait" "Bahrain" "Qatar"
## [19] "United Arab Emirates" "Oman" "Israel"
##
## $`8`
## [1] "Mali" "Guinea" "Senegal" "Benin"
## [5] "Niger" "Ivory Coast" "Burkina Faso" "Togo"
## [9] "Cape Verde" "Guinea-Bissau" "Gambia" "Liberia"
## [13] "Sierra Leone" "Ghana" "Nigeria"
##
## $`9`
## [1] "South Africa" "Swaziland"
print(blockmodel(alliances.stat,alliances.wt$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.3913 0.000 0.0321 0.0035 0.000 0.0000 0.0021 0.0000
## Block 2 0.0000 1.000 0.0000 0.0000 0.000 0.0333 0.0000 0.0000
## Block 3 0.0321 0.000 0.6126 0.0400 0.014 0.0029 0.0000 0.0000
## Block 4 0.0035 0.000 0.0400 0.8468 0.000 0.0000 0.0000 0.0018
## Block 5 0.0000 0.000 0.0145 0.0000 1.000 0.0000 0.0000 0.0000
## Block 6 0.0000 0.033 0.0029 0.0000 0.000 0.8095 0.0349 0.0000
## Block 7 0.0021 0.000 0.0000 0.0000 0.000 0.0349 0.9143 0.0000
## Block 8 0.0000 0.000 0.0000 0.0018 0.000 0.0000 0.0000 1.0000
## Block 9 0.0000 0.000 0.0000 0.0000 0.000 0.0000 0.0000 0.0000
## Block 9
## Block 1 0
## Block 2 0
## Block 3 0
## Block 4 0
## Block 5 0
## Block 6 0
## Block 7 0
## Block 8 0
## Block 9 1
alliances.nodes$comm.wt<-alliances.wt$membership
nodes.by.gp(alliances.nodes,"comm.wt")
## comm.wt degree degree.wt betweenness close constraint eigen
## [1,] 1 19.0 15.0 449 0.3754 0.39 1.5e-03
## [2,] 2 3.0 1.5 137 0.2099 0.75 9.4e-08
## [3,] 3 31.6 19.2 323 0.4334 0.25 1.6e-02
## [4,] 4 63.0 33.6 282 0.4780 0.19 1.6e-01
## [5,] 5 4.7 2.3 181 0.2741 0.88 2.3e-04
## [6,] 6 24.4 14.5 413 0.3502 0.28 6.5e-05
## [7,] 7 37.7 34.3 250 0.3467 0.22 1.8e-06
## [8,] 8 28.1 14.2 231 0.3398 0.26 6.3e-04
## [9,] 9 2.0 1.0 0 0.0071 1.00 7.5e-64
## eigen.rc eigen.dc comm.fg n
## [1,] 9.7e-05 1.4e-03 2.0 23
## [2,] 1.6e-08 7.7e-08 1.0 2
## [3,] 7.4e-04 1.6e-02 2.8 23
## [4,] 4.7e-03 1.5e-01 7.3 37
## [5,] 2.9e-05 2.0e-04 4.0 3
## [6,] 4.7e-06 6.0e-05 1.0 15
## [7,] 9.5e-08 1.7e-06 5.8 21
## [8,] 4.1e-05 5.9e-04 7.0 15
## [9,] 7.5e-64 0.0e+00 5.0 2
plot(alliances.wt,alliances.ig)
airports.fl.wt<-walktrap.community(airports.fl.ig)
print(blockmodel(airports.fl.stat,airports.fl.wt$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.4500 0.0271 0.0000 0.067 0.0067
## Block 2 0.0271 0.2557 0.0056 0.127 0.0812
## Block 3 0.0000 0.0056 1.0000 0.000 0.0889
## Block 4 0.0667 0.1158 0.0000 0.567 0.0139
## Block 5 0.0067 0.0832 0.0917 0.013 0.2112
airports.fl.nodes$comm.wt<-airports.fl.wt$membership
nodes.by.gp(airports.fl.nodes,"comm.wt")
## comm.wt degree degree.wt betweenness close constraint eigen eigen.rc
## [1,] 1 9.2 837 102.3 0.39 0.74 0.0071 0.00014
## [2,] 2 51.2 6053 176.0 0.51 0.24 0.0480 0.00082
## [3,] 3 26.3 3210 9.4 0.48 0.50 0.0330 0.00043
## [4,] 4 23.8 3320 108.4 0.44 0.58 0.0224 0.00038
## [5,] 5 60.7 6957 211.3 0.52 0.20 0.0626 0.00104
## eigen.dc comm.fg n
## [1,] 0.0069 1.0 5
## [2,] 0.0472 2.0 59
## [3,] 0.0325 6.0 3
## [4,] 0.0220 2.0 6
## [5,] 0.0616 3.4 120
plot(airports.fl.wt,airports.fl.ig)
airports.geo.wt<-walktrap.community(airports.geo.ig)
print(blockmodel(airports.geo.stat,airports.geo.wt$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.241 0.010 0.072 0.016
## Block 2 0.010 0.411 0.077 0.000
## Block 3 0.074 0.076 0.208 0.000
## Block 4 0.016 0.000 0.000 NaN
airports.geo.nodes$comm.wt<-airports.geo.wt$membership
nodes.by.gp(airports.geo.nodes,"comm.wt")
## comm.wt degree degree.wt betweenness close eigen eigen.rc eigen.dc
## [1,] 1 47 51490 184 0.49 0.04316 7.6e-04 0.0424
## [2,] 2 26 17437 39 0.46 0.02026 4.4e-04 0.0198
## [3,] 3 61 45642 207 0.52 0.06357 1.0e-03 0.0625
## [4,] 4 2 798 0 0.33 0.00054 3.6e-05 0.0005
## comm.fg n
## [1,] 2.5 61
## [2,] 1.2 8
## [3,] 2.6 123
## [4,] 3.0 1
plot(airports.geo.wt,airports.geo.ig)
How different are the community clusters that were created using this method? It is possible to manually compare the block densities within and between the community groups, compare the average node statistics in the resulting communities, or visually inspect the colored network plots. One alternative approach is to directly compare the modularity index produced by each partition.
#compare community partition modularity scores
modularity(comm.fg)
## [1] 0.4410431
modularity(comm.wt)
## [1] 0.3922902
As expected, the partition produced by the fast, greedy algorithm is characterized by a higher modularity score than the one produced by the walktrap algorithm. This is expected because the goal of fast, greedy is to optimize modularity. But would you agree that the resulting partition is necessariy superior to the community partiton produced by walktrap?
One thing to notice is that as we compare additional algorithms, it will be easier to simply add each new modularity score to a list and return that list for comparison, rather than cutting and pasting the code to recover each individual modularity index each time. To do this, we will use c() to create a new list, called mods, and will add to this list with each algorithm.
#collect modularity scores to compare
mods<-c(fastgreedy=modularity(comm.fg), walktrap=modularity(comm.wt))
mods
## fastgreedy walktrap
## 0.4410431 0.3922902
Another approach is to use the compare function which provides several different methods for comparing the network partitions: "vi", "nmi", "split.join", "rand", "adjusted.rand". For a relatively accessible (but still sort of challenging) overview of the different approaches to comparing network partitions, see this article.
Differences between two partitions can be calculated using the two entropy-based information measures vi and nmi, plus split.join. nmi varies between 0 and 1, while vi has a much higher upper bound than nmi. split.join is also a distance based measure, capturing the projection distance between the two partitions - or intuitively how many moves (like a Rubiks Cube) are required to go from one partition to another. It returns two values (as the distance from partition A to partition B is not necessariy the same as the distance from partition B to partition A.) Higher numbers on split.join mean that two partitions are less similar to (or more distant from) each other. vi is more affected by the number of community groups than slit.join.
Both Rand index measures vary between 0 and 1, and indicate the proportion of times that the two partitioning methods agree that two nodes belong in the same community, with the adjusted version also taking into account the possibility of random variation in clustering. For now, lets see the results of all 5 methods.
#compare community partitions using variation of information
compare(comm.fg,comm.wt,method="vi")
## [1] 0.2386928
#compare community partitions using normalized mutual information
compare(comm.fg,comm.wt,method="nmi")
## [1] 0.9129178
#compare community partitions using split join distance
compare(comm.fg,comm.wt,method="split.join")
## [1] 2
#compare community partitions using Rand index
compare(comm.fg,comm.wt,method="rand")
## [1] 0.9333333
#compare community partitions using adjusted Rand index
compare(comm.fg,comm.wt,method="adjusted.rand")
## [1] 0.8100514
One thing to notice comparing the two Rand index measures is that the adjusted one is much lower than the standard measure not adjusted for random variation in clustering. The two partitions appear to be fairly similar based on the Rand index, but less so once random variation is taken into account. In and of itself, the comparison scores don’t tell us which method is better - but they do provide a sense of how similar the partitions produced by two methods are - and thus can be useful when comparing the results of a specific partitioning approach to a gold standard partition.
Finally, note that once again, the code in the previous R snippet will start to grow much longer as we try to compare additional community partition algorithms. An alternative is to use a custom function that uses expand.grid in combination with a for() loop to quickly cycle through multiple combinations and calculate the comparative metrics.
compare.algs<-function(alg.a,alg.b,compare.meth=c("vi", "nmi", "split.join", "rand", "adjusted.rand")){
#create list of community objects and methods
comm.compare<-expand.grid(alg.a=alg.a, alg.b=alg.b, meth=compare.meth, result=NA, stringsAsFactors = FALSE)
#compare community partitions using a loop
for(i in 1:nrow(comm.compare)){
comm1<-get(comm.compare$alg.a[i])
comm2<-get(comm.compare$alg.b[i])
method<-comm.compare$meth[i]
comm.compare$result[i]<-compare(comm1, comm2, method)
}
return(comm.compare)
}
Once the compare.algs() function is set up, all you need to do is provide it with a vector of the community object names (alg.a) that you wish to compare to the baseline community partition (alg.b). Note that you can decide which methods to use to compare partitions. By default, the compare.algs function currently returns all 5 available metrics.
#compare community partitions
compare.algs(alg.a=c("comm.fg"),alg.b="comm.wt")
## alg.a alg.b meth result
## 1 comm.fg comm.wt vi 0.2386928
## 2 comm.fg comm.wt nmi 0.9129178
## 3 comm.fg comm.wt split.join 2.0000000
## 4 comm.fg comm.wt rand 0.9333333
## 5 comm.fg comm.wt adjusted.rand 0.8100514
Compare the fast, greedy partition to the walktrap partition you created using your chosen network. How similar are the two partitions, particularly in comparison to the similarity that we observed in the community partitions of the Florentine marriage network or some other network you have inspected?
#collect modularity scores to compare
#compare community partitions
#collect modularity scores to compare
got.mods<-c(fastgreedy=modularity(got.fg), walktrap=modularity(got.wt))
got.mods
## fastgreedy walktrap
## 0.5173683 0.3289444
#compare community partitions
compare.algs(alg.a=c("got.fg"),alg.b="got.wt")
## alg.a alg.b meth result
## 1 got.fg got.wt vi 0.2310491
## 2 got.fg got.wt nmi 0.9288836
## 3 got.fg got.wt split.join 3.0000000
## 4 got.fg got.wt rand 0.9411765
## 5 got.fg got.wt adjusted.rand 0.7895461
#alliances
alliances.mods<-c(fastgreedy=modularity(alliances.fg), walktrap=modularity(alliances.wt))
alliances.mods
## fastgreedy walktrap
## 0.6992952 0.7130571
#compare community partitions
compare.algs(alg.a=c("alliances.fg"),alg.b="alliances.wt")
## alg.a alg.b meth result
## 1 alliances.fg alliances.wt vi 0.4462969
## 2 alliances.fg alliances.wt nmi 0.8819498
## 3 alliances.fg alliances.wt split.join 22.0000000
## 4 alliances.fg alliances.wt rand 0.9503546
## 5 alliances.fg alliances.wt adjusted.rand 0.8159499
#airports.flights
airports.fl.mods<-c(fastgreedy=modularity(airports.fl.fg), walktrap=modularity(airports.fl.wt))
airports.fl.mods
## fastgreedy walktrap
## 0.2852924 0.2462541
#compare community partitions
compare.algs(alg.a=c("airports.fl.fg"),alg.b="airports.fl.wt")
## alg.a alg.b meth result
## 1 airports.fl.fg airports.fl.wt vi 0.9678233
## 2 airports.fl.fg airports.fl.wt nmi 0.5733823
## 3 airports.fl.fg airports.fl.wt split.join 69.0000000
## 4 airports.fl.fg airports.fl.wt rand 0.7712651
## 5 airports.fl.fg airports.fl.wt adjusted.rand 0.5353747
#airports.geograph
airports.geo.mods<-c(fastgreedy=modularity(airports.geo.fg), walktrap=modularity(airports.geo.wt))
airports.geo.mods
## fastgreedy walktrap
## 0.15264777 0.08146168
#compare community partitions
compare.algs(alg.a=c("airports.geo.fg"),alg.b="airports.geo.wt")
## alg.a alg.b meth result
## 1 airports.geo.fg airports.geo.wt vi 1.7309768
## 2 airports.geo.fg airports.geo.wt nmi 0.2118287
## 3 airports.geo.fg airports.geo.wt split.join 155.0000000
## 4 airports.geo.fg airports.geo.wt rand 0.5717293
## 5 airports.geo.fg airports.geo.wt adjusted.rand 0.1479846
Label propogation is a fast algorithm that uses neighborhood voting to find communities. It can used weighted networks if you have a weight edge attribute or use the options weights=.
#Run clustering algorithm: leading label
comm.lab<-label.propagation.community(flomarr.ig)
#Inspect community membership
igraph::groups(comm.lab)
## $`1`
## [1] "Acciaiuoli" "Albizzi" "Ginori" "Guadagni"
## [5] "Lamberteschi" "Medici" "Pazzi" "Ridolfi"
## [9] "Salviati" "Tornabuoni"
##
## $`2`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`3`
## [1] "Pucci"
We can describe and plot the label propagation communities.
#inspect density of between/within community ties
print(blockmodel(flomarr.stat,comm.lab$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3
## Block 1 0.24 0.06 0
## Block 2 0.06 0.60 0
## Block 3 0.00 0.00 NaN
#add community membership as a vertex attribute
flomarr.nodes$comm.lab<-comm.lab$membership
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.lab")
## comm.lab degree betweenness close constraint eigen eigen.rc eigen.dc
## [1,] 1 2.5 12.2 0 0.62 0.21 0.065 0.15
## [2,] 2 3.0 6.9 0 0.52 0.28 0.082 0.19
## [3,] 3 0.0 0.0 0 0.00 0.00 NaN NaN
## comm.fg comm.wt n
## [1,] 1.4 2 10
## [2,] 3.0 3 5
## [3,] 4.0 5 1
#plot network with community coloring
plot(comm.lab,flomarr.ig)
Finally, lets compare the different community partitions. Note that you can use the c() function to just add a new item, the modularity index of our new community partition, to the vector of modularity scores, mods. Similarly, we just add the two previous algorithms to the alg.a vector, and then set the new algorithm to be alg.b.
#collect modularity scores to compare
mods<-c(mods, label=modularity(comm.lab))
mods
## fastgreedy walktrap label
## 0.4410431 0.3922902 0.3730159
#compare community partitions
compare.algs(alg.a=c("comm.fg","comm.wt"),alg.b="comm.lab")
## alg.a alg.b meth result
## 1 comm.fg comm.lab vi 0.4206323
## 2 comm.wt comm.lab vi 0.6593251
## 3 comm.fg comm.lab nmi 0.7979361
## 4 comm.wt comm.lab nmi 0.7158538
## 5 comm.fg comm.lab split.join 4.0000000
## 6 comm.wt comm.lab split.join 6.0000000
## 7 comm.fg comm.lab rand 0.8000000
## 8 comm.wt comm.lab rand 0.7333333
## 9 comm.fg comm.lab adjusted.rand 0.5832127
## 10 comm.wt comm.lab adjusted.rand 0.4377745
Repeat the basic community analysis routine for one of the other datasets provided this week.
#Run clustering algorithm: leading label
#Inspect community membership
#inspect density of between/within community ties
#add community membership as a vertex attribute
#summarize node statistics by community
#plot the network with community coloring
#collect modularity scores to compare
#compare community partitions
#Run clustering algorithm: leading label
got.lab<-walktrap.community(gotmarr.ig)
#Inspect community membership
igraph::groups(got.lab)
## $`1`
## [1] "Arryn" "Tully" "Vale" "Stormlands" "Riverlands"
## [6] "Frey"
##
## $`2`
## [1] "Martell" "Crownlands" "Essos" "Targaryen" "Dorne"
##
## $`3`
## [1] "Baratheon" "Reach" "Tyrell"
##
## $`4`
## [1] "Stark" "North"
##
## $`5`
## [1] "Lannister" "Westerlands"
#inspect density of between/within community ties
print(blockmodel(gotmarr.stat,got.lab$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.53 0.23 0.22 0.33 0.17
## Block 2 0.23 0.60 0.20 0.20 0.20
## Block 3 0.22 0.20 1.00 0.33 0.50
## Block 4 0.33 0.20 0.33 1.00 0.50
## Block 5 0.17 0.20 0.50 0.50 1.00
#add community membership as a vertex attribute
gotmarr.nodes$comm.lab<-got.lab$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.lab")
## comm.lab degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 5.5 23 -1.31 4.5 0.58 0.41 0.22
## [2,] 2 5.2 22 -0.79 9.3 0.57 0.62 0.20
## [3,] 3 6.0 22 -0.96 8.9 0.59 0.45 0.22
## [4,] 4 6.0 36 -0.29 6.9 0.59 0.53 0.24
## [5,] 5 5.5 25 -0.15 1.4 0.58 0.57 0.25
## eigen.rc eigen.dc comm.fg comm.wt n
## [1,] 0.047 0.17 2.5 1 6
## [2,] 0.041 0.16 2.0 2 5
## [3,] 0.039 0.18 3.0 3 3
## [4,] 0.114 0.12 6.0 4 2
## [5,] 0.095 0.16 5.0 5 2
#plot the network with community coloring
plot(got.lab,gotmarr.ig)
#collect modularity scores to compare
got.mods<-c(got.mods, label=modularity(got.lab))
got.mods
## fastgreedy walktrap label
## 0.5173683 0.3289444 0.3289444
#compare community partitions
compare.algs(alg.a=c("got.fg","got.wt"),alg.b="got.lab")
## alg.a alg.b meth result
## 1 got.fg got.lab vi 0.2310491
## 2 got.wt got.lab vi 0.0000000
## 3 got.fg got.lab nmi 0.9288836
## 4 got.wt got.lab nmi 1.0000000
## 5 got.fg got.lab split.join 3.0000000
## 6 got.wt got.lab split.join 0.0000000
## 7 got.fg got.lab rand 0.9411765
## 8 got.wt got.lab rand 1.0000000
## 9 got.fg got.lab adjusted.rand 0.7895461
## 10 got.wt got.lab adjusted.rand 1.0000000
#alliances
alliances.lab<-walktrap.community(alliances.ig)
igraph::groups(alliances.lab)
## $`1`
## [1] "Russia" "Iran" "Latvia" "Pakistan"
## [5] "China" "Afghanistan" "India" "North Korea"
## [9] "Moldova" "Ukraine" "Belarus" "Armenia"
## [13] "Georgia" "Azerbaijan" "Turkmenistan" "Tajikistan"
## [17] "Kyrgyzstan" "Uzbekistan" "Lithuania" "Kazakhstan"
## [21] "Finland" "Mongolia" "South Korea"
##
## $`2`
## [1] "Ethiopia" "Eritrea"
##
## $`3`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Spain" "Greece"
## [9] "Bulgaria" "Romania"
## [11] "Turkey" "Poland"
## [13] "Estonia" "Hungary"
## [15] "Albania" "Luxembourg"
## [17] "Portugal" "German Federal Republic"
## [19] "Czech Republic" "Norway"
## [21] "Denmark" "Iceland"
## [23] "Slovakia"
##
## $`4`
## [1] "Paraguay" "Brazil"
## [3] "Ecuador" "Peru"
## [5] "Colombia" "Argentina"
## [7] "Bolivia" "Guatemala"
## [9] "Honduras" "El Salvador"
## [11] "Nicaragua" "United States of America"
## [13] "Haiti" "Dominican Republic"
## [15] "Mexico" "Costa Rica"
## [17] "Panama" "Venezuela"
## [19] "Chile" "Japan"
## [21] "Australia" "Canada"
## [23] "Bahamas" "Jamaica"
## [25] "Trinidad and Tobago" "Barbados"
## [27] "Dominica" "Grenada"
## [29] "St. Lucia" "St. Vincent and the Grenadines"
## [31] "Antigua & Barbuda" "St. Kitts and Nevis"
## [33] "Belize" "Guyana"
## [35] "Suriname" "Philippines"
## [37] "Uruguay"
##
## $`5`
## [1] "Yugoslavia" "Croatia"
## [3] "Bosnia and Herzegovina"
##
## $`6`
## [1] "Central African Republic" "Chad"
## [3] "Cameroon" "Gabon"
## [5] "Congo" "Rwanda"
## [7] "Kenya" "Democratic Republic of the Congo"
## [9] "Burundi" "Uganda"
## [11] "Angola" "Sao Tome and Principe"
## [13] "Equatorial Guinea" "Tanzania"
## [15] "Zambia"
##
## $`7`
## [1] "Saudi Arabia" "Iraq" "Mauritania"
## [4] "Somalia" "Djibouti" "Morocco"
## [7] "Algeria" "Tunisia" "Libya"
## [10] "Sudan" "Egypt" "Syria"
## [13] "Lebanon" "Jordan" "Yemen"
## [16] "Kuwait" "Bahrain" "Qatar"
## [19] "United Arab Emirates" "Oman" "Israel"
##
## $`8`
## [1] "Mali" "Guinea" "Senegal" "Benin"
## [5] "Niger" "Ivory Coast" "Burkina Faso" "Togo"
## [9] "Cape Verde" "Guinea-Bissau" "Gambia" "Liberia"
## [13] "Sierra Leone" "Ghana" "Nigeria"
##
## $`9`
## [1] "South Africa" "Swaziland"
print(blockmodel(alliances.stat,alliances.lab$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.3913 0.000 0.0321 0.0035 0.000 0.0000 0.0021 0.0000
## Block 2 0.0000 1.000 0.0000 0.0000 0.000 0.0333 0.0000 0.0000
## Block 3 0.0321 0.000 0.6126 0.0400 0.014 0.0029 0.0000 0.0000
## Block 4 0.0035 0.000 0.0400 0.8468 0.000 0.0000 0.0000 0.0018
## Block 5 0.0000 0.000 0.0145 0.0000 1.000 0.0000 0.0000 0.0000
## Block 6 0.0000 0.033 0.0029 0.0000 0.000 0.8095 0.0349 0.0000
## Block 7 0.0021 0.000 0.0000 0.0000 0.000 0.0349 0.9143 0.0000
## Block 8 0.0000 0.000 0.0000 0.0018 0.000 0.0000 0.0000 1.0000
## Block 9 0.0000 0.000 0.0000 0.0000 0.000 0.0000 0.0000 0.0000
## Block 9
## Block 1 0
## Block 2 0
## Block 3 0
## Block 4 0
## Block 5 0
## Block 6 0
## Block 7 0
## Block 8 0
## Block 9 1
alliances.nodes$comm.lab<-alliances.lab$membership
nodes.by.gp(alliances.nodes,"comm.lab")
## comm.lab degree degree.wt betweenness close constraint eigen
## [1,] 1 19.0 15.0 449 0.3754 0.39 1.5e-03
## [2,] 2 3.0 1.5 137 0.2099 0.75 9.4e-08
## [3,] 3 31.6 19.2 323 0.4334 0.25 1.6e-02
## [4,] 4 63.0 33.6 282 0.4780 0.19 1.6e-01
## [5,] 5 4.7 2.3 181 0.2741 0.88 2.3e-04
## [6,] 6 24.4 14.5 413 0.3502 0.28 6.5e-05
## [7,] 7 37.7 34.3 250 0.3467 0.22 1.8e-06
## [8,] 8 28.1 14.2 231 0.3398 0.26 6.3e-04
## [9,] 9 2.0 1.0 0 0.0071 1.00 7.5e-64
## eigen.rc eigen.dc comm.fg comm.wt n
## [1,] 9.7e-05 1.4e-03 2.0 1 23
## [2,] 1.6e-08 7.7e-08 1.0 2 2
## [3,] 7.4e-04 1.6e-02 2.8 3 23
## [4,] 4.7e-03 1.5e-01 7.3 4 37
## [5,] 2.9e-05 2.0e-04 4.0 5 3
## [6,] 4.7e-06 6.0e-05 1.0 6 15
## [7,] 9.5e-08 1.7e-06 5.8 7 21
## [8,] 4.1e-05 5.9e-04 7.0 8 15
## [9,] 7.5e-64 0.0e+00 5.0 9 2
plot(alliances.lab,alliances.ig)
alliances.mods<-c(alliances.mods, label=modularity(alliances.lab))
alliances.mods
## fastgreedy walktrap label
## 0.6992952 0.7130571 0.7130571
compare.algs(alg.a=c("alliances.fg","alliances.wt"),alg.b="alliances.lab")
## alg.a alg.b meth result
## 1 alliances.fg alliances.lab vi 0.4462969
## 2 alliances.wt alliances.lab vi 0.0000000
## 3 alliances.fg alliances.lab nmi 0.8819498
## 4 alliances.wt alliances.lab nmi 1.0000000
## 5 alliances.fg alliances.lab split.join 22.0000000
## 6 alliances.wt alliances.lab split.join 0.0000000
## 7 alliances.fg alliances.lab rand 0.9503546
## 8 alliances.wt alliances.lab rand 1.0000000
## 9 alliances.fg alliances.lab adjusted.rand 0.8159499
## 10 alliances.wt alliances.lab adjusted.rand 1.0000000
#airport flights
airports.fl.lab<-walktrap.community(airports.fl.ig)
igraph::groups(airports.fl.lab)
## $`1`
## [1] "ANC" "BET" "FAI" "JNU" "KTN"
##
## $`2`
## [1] "ABQ" "AMA" "ASE" "AUS" "AZA" "BIL" "BIS" "BLI" "BOI" "BUR" "BZN"
## [12] "COS" "CRP" "DAL" "DEN" "DRO" "EGE" "ELP" "EUG" "FAR" "FAT" "FSD"
## [23] "GEG" "GJT" "GTF" "HOU" "HRL" "IDA" "JAC" "LAS" "LAX" "LBB" "LGB"
## [34] "MAF" "MFE" "MFR" "MRY" "MSO" "OAK" "OKC" "ONT" "PDX" "PHX" "PSC"
## [45] "PSP" "RAP" "RDM" "RNO" "SAN" "SAT" "SBA" "SEA" "SFO" "SJC" "SLC"
## [56] "SMF" "SNA" "TUL" "TUS"
##
## $`3`
## [1] "SJU" "STT" "STX"
##
## $`4`
## [1] "GUM" "HNL" "ITO" "KOA" "LIH" "OGG"
##
## $`5`
## [1] "ABE" "ACY" "AGS" "ALB" "ATL" "ATW" "AVL" "AVP" "AZO" "BDL" "BGR"
## [12] "BHM" "BMI" "BNA" "BOS" "BQN" "BTR" "BTV" "BUF" "BWI" "CAE" "CAK"
## [23] "CHA" "CHO" "CHS" "CID" "CLE" "CLT" "CMH" "CRW" "CVG" "DAB" "DAY"
## [34] "DCA" "DFW" "DSM" "DTW" "ECP" "ELM" "EVV" "EWR" "EYW" "FAY" "FLL"
## [45] "FNT" "FWA" "GNV" "GPT" "GRB" "GRK" "GRR" "GSO" "GSP" "HPN" "HSV"
## [56] "IAD" "IAH" "ICT" "ILM" "IND" "ISP" "JAN" "JAX" "JFK" "LEX" "LFT"
## [67] "LGA" "LIT" "MCI" "MCO" "MDT" "MDW" "MEM" "MGM" "MHT" "MIA" "MKE"
## [78] "MLB" "MLI" "MOB" "MSN" "MSP" "MSY" "MYR" "OAJ" "OMA" "ORD" "ORF"
## [89] "PBI" "PGD" "PHF" "PHL" "PIA" "PIE" "PIT" "PNS" "PVD" "PWM" "RDU"
## [100] "RIC" "ROA" "ROC" "RSW" "SAV" "SBN" "SCE" "SDF" "SFB" "SGF" "SHV"
## [111] "SRQ" "STL" "SWF" "SYR" "TLH" "TPA" "TRI" "TYS" "VPS" "XNA"
print(blockmodel(airports.fl.stat,airports.fl.lab$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.4500 0.0271 0.0000 0.067 0.0067
## Block 2 0.0271 0.2557 0.0056 0.127 0.0812
## Block 3 0.0000 0.0056 1.0000 0.000 0.0889
## Block 4 0.0667 0.1158 0.0000 0.567 0.0139
## Block 5 0.0067 0.0832 0.0917 0.013 0.2112
airports.fl.nodes$comm.lab<-airports.fl.lab$membership
nodes.by.gp(airports.fl.nodes,"comm.lab")
## comm.lab degree degree.wt betweenness close constraint eigen
## [1,] 1 9.2 837 102.3 0.39 0.74 0.0071
## [2,] 2 51.2 6053 176.0 0.51 0.24 0.0480
## [3,] 3 26.3 3210 9.4 0.48 0.50 0.0330
## [4,] 4 23.8 3320 108.4 0.44 0.58 0.0224
## [5,] 5 60.7 6957 211.3 0.52 0.20 0.0626
## eigen.rc eigen.dc comm.fg comm.wt n
## [1,] 0.00014 0.0069 1.0 1 5
## [2,] 0.00082 0.0472 2.0 2 59
## [3,] 0.00043 0.0325 6.0 3 3
## [4,] 0.00038 0.0220 2.0 4 6
## [5,] 0.00104 0.0616 3.4 5 120
plot(airports.fl.lab,airports.fl.ig)
airports.fl.mods<-c(airports.fl.mods, label=modularity(airports.fl.lab))
airports.fl.mods
## fastgreedy walktrap label
## 0.2852924 0.2462541 0.2462541
compare.algs(alg.a=c("airports.fl.fg","airports.fl.wt"),alg.b="airports.fl.lab")
## alg.a alg.b meth result
## 1 airports.fl.fg airports.fl.lab vi 0.9678233
## 2 airports.fl.wt airports.fl.lab vi 0.0000000
## 3 airports.fl.fg airports.fl.lab nmi 0.5733823
## 4 airports.fl.wt airports.fl.lab nmi 1.0000000
## 5 airports.fl.fg airports.fl.lab split.join 69.0000000
## 6 airports.fl.wt airports.fl.lab split.join 0.0000000
## 7 airports.fl.fg airports.fl.lab rand 0.7712651
## 8 airports.fl.wt airports.fl.lab rand 1.0000000
## 9 airports.fl.fg airports.fl.lab adjusted.rand 0.5353747
## 10 airports.fl.wt airports.fl.lab adjusted.rand 1.0000000
#airport geography
airports.geo.lab<-walktrap.community(airports.geo.ig)
igraph::groups(airports.geo.lab)
## $`1`
## [1] "ABQ" "AMA" "ANC" "ASE" "AUS" "AZA" "BIL" "BIS" "BLI" "BOI" "BUR"
## [12] "BZN" "COS" "DEN" "DRO" "ELP" "EUG" "FAI" "FAR" "FAT" "FSD" "GEG"
## [23] "GJT" "GTF" "GUM" "HNL" "HRL" "IDA" "ITO" "JNU" "KOA" "KTN" "LAS"
## [34] "LAX" "LBB" "LGB" "LIH" "MAF" "MFR" "MRY" "MSO" "OAK" "OGG" "ONT"
## [45] "PDX" "PHX" "PSC" "PSP" "RAP" "RDM" "RNO" "SAN" "SBA" "SEA" "SFO"
## [56] "SJC" "SLC" "SMF" "SNA" "TUL" "TUS"
##
## $`2`
## [1] "AZO" "BGR" "FWA" "PGD" "PIE" "ROA" "SBN" "SFB"
##
## $`3`
## [1] "ABE" "ACY" "AGS" "ALB" "ATL" "ATW" "AVL" "AVP" "BDL" "BHM" "BMI"
## [12] "BNA" "BOS" "BQN" "BTR" "BTV" "BUF" "BWI" "CAE" "CAK" "CHA" "CHO"
## [23] "CHS" "CID" "CLE" "CLT" "CMH" "CRP" "CRW" "CVG" "DAB" "DAL" "DAY"
## [34] "DCA" "DFW" "DSM" "DTW" "ECP" "EGE" "ELM" "EVV" "EWR" "EYW" "FAY"
## [45] "FLL" "FNT" "GNV" "GPT" "GRB" "GRK" "GRR" "GSO" "GSP" "HOU" "HPN"
## [56] "HSV" "IAD" "IAH" "ICT" "ILM" "IND" "ISP" "JAC" "JAN" "JAX" "JFK"
## [67] "LEX" "LFT" "LGA" "LIT" "MCI" "MCO" "MDT" "MDW" "MEM" "MFE" "MGM"
## [78] "MHT" "MIA" "MKE" "MLB" "MLI" "MOB" "MSN" "MSP" "MSY" "MYR" "OAJ"
## [89] "OKC" "OMA" "ORD" "ORF" "PBI" "PHF" "PHL" "PIA" "PIT" "PNS" "PVD"
## [100] "PWM" "RDU" "RIC" "ROC" "RSW" "SAT" "SAV" "SCE" "SDF" "SGF" "SHV"
## [111] "SJU" "SRQ" "STL" "STT" "STX" "SWF" "SYR" "TLH" "TPA" "TRI" "TYS"
## [122] "VPS" "XNA"
##
## $`4`
## [1] "BET"
print(blockmodel(airports.geo.stat,airports.geo.lab$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.241 0.010 0.072 0.016
## Block 2 0.010 0.411 0.077 0.000
## Block 3 0.074 0.076 0.208 0.000
## Block 4 0.016 0.000 0.000 NaN
airports.geo.nodes$comm.lab<-airports.geo.lab$membership
nodes.by.gp(airports.geo.nodes,"comm.lab")
## comm.lab degree degree.wt betweenness close eigen eigen.rc eigen.dc
## [1,] 1 47 51490 184 0.49 0.04316 7.6e-04 0.0424
## [2,] 2 26 17437 39 0.46 0.02026 4.4e-04 0.0198
## [3,] 3 61 45642 207 0.52 0.06357 1.0e-03 0.0625
## [4,] 4 2 798 0 0.33 0.00054 3.6e-05 0.0005
## comm.fg comm.wt n
## [1,] 2.5 1 61
## [2,] 1.2 2 8
## [3,] 2.6 3 123
## [4,] 3.0 4 1
plot(airports.geo.lab,airports.geo.ig)
airports.geo.mods<-c(airports.geo.mods, label=modularity(airports.geo.lab))
airports.geo.mods
## fastgreedy walktrap label
## 0.15264777 0.08146168 0.08146168
compare.algs(alg.a=c("airports.geo.fg","airports.geo.wt"),alg.b="airports.geo.lab")
## alg.a alg.b meth result
## 1 airports.geo.fg airports.geo.lab vi 1.7309768
## 2 airports.geo.wt airports.geo.lab vi 0.0000000
## 3 airports.geo.fg airports.geo.lab nmi 0.2118287
## 4 airports.geo.wt airports.geo.lab nmi 1.0000000
## 5 airports.geo.fg airports.geo.lab split.join 155.0000000
## 6 airports.geo.wt airports.geo.lab split.join 0.0000000
## 7 airports.geo.fg airports.geo.lab rand 0.5717293
## 8 airports.geo.wt airports.geo.lab rand 1.0000000
## 9 airports.geo.fg airports.geo.lab adjusted.rand 0.1479846
## 10 airports.geo.wt airports.geo.lab adjusted.rand 1.0000000
Edge betweenness looks for communities with sparse connections between them and works by eliminating high betweenness nodes. It can used weighted networks if you have a weight edge attribute or use the options weights=. The algorithm automatically adjusts betweenness scores for directed networks, although this can be adjusted by setting the option directed=FALSE.
#Run clustering algorithm: edge betweenness
comm.edge<-label.propagation.community(flomarr.ig)
#Inspect community membership
igraph::groups(comm.edge)
## $`1`
## [1] "Acciaiuoli" "Albizzi" "Ginori" "Guadagni"
## [5] "Lamberteschi" "Medici" "Pazzi" "Ridolfi"
## [9] "Salviati" "Tornabuoni"
##
## $`2`
## [1] "Barbadori" "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`3`
## [1] "Pucci"
We can describe and plot the edge betweenness communities.
#inspect density of between/within community ties
print(blockmodel(flomarr.stat,comm.edge$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3
## Block 1 0.24 0.06 0
## Block 2 0.06 0.60 0
## Block 3 0.00 0.00 NaN
#add community membership as a vertex attribute
flomarr.nodes$comm.edge<-comm.edge$membership
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.edge")
## comm.edge degree betweenness close constraint eigen eigen.rc eigen.dc
## [1,] 1 2.5 12.2 0 0.62 0.21 0.065 0.15
## [2,] 2 3.0 6.9 0 0.52 0.28 0.082 0.19
## [3,] 3 0.0 0.0 0 0.00 0.00 NaN NaN
## comm.fg comm.wt comm.lab n
## [1,] 1.4 2 1 10
## [2,] 3.0 3 2 5
## [3,] 4.0 5 3 1
#plot network with community coloring
plot(comm.edge,flomarr.ig)
Compare the various community partitions created so far by adding to the modularity index vector and using our custom function.
#collect modularity scores to compare
mods<-c(mods, edge=modularity(comm.edge))
mods
## fastgreedy walktrap label edge
## 0.4410431 0.3922902 0.3730159 0.3730159
#compare community partitions
compare.algs(alg.a=c("comm.fg","comm.wt", "comm.lab"), alg.b="comm.edge")
## alg.a alg.b meth result
## 1 comm.fg comm.edge vi 0.4206323
## 2 comm.wt comm.edge vi 0.6593251
## 3 comm.lab comm.edge vi 0.0000000
## 4 comm.fg comm.edge nmi 0.7979361
## 5 comm.wt comm.edge nmi 0.7158538
## 6 comm.lab comm.edge nmi 1.0000000
## 7 comm.fg comm.edge split.join 4.0000000
## 8 comm.wt comm.edge split.join 6.0000000
## 9 comm.lab comm.edge split.join 0.0000000
## 10 comm.fg comm.edge rand 0.8000000
## 11 comm.wt comm.edge rand 0.7333333
## 12 comm.lab comm.edge rand 1.0000000
## 13 comm.fg comm.edge adjusted.rand 0.5832127
## 14 comm.wt comm.edge adjusted.rand 0.4377745
## 15 comm.lab comm.edge adjusted.rand 1.0000000
Repeat the basic community analysis routine for one of the other datasets provided this week.
#Run clustering algorithm: edge betweenness
#Inspect community membership
#inspect density of between/within community ties
#add community membership as a vertex attribute
#summarize node statistics by community
#plot the network with community coloring
#compare modularity scores
#compare community partitions
#Run clustering algorithm: edge betweenness
got.edge<-edge.betweenness.community(gotmarr.ig)
## Warning in edge.betweenness.community(gotmarr.ig): At community.c:
## 460 :Membership vector will be selected based on the lowest modularity
## score.
## Warning in edge.betweenness.community(gotmarr.ig): At community.c:
## 467 :Modularity calculation with weighted edge betweenness community
## detection might not make sense -- modularity treats edge weights as
## similarities while edge betwenness treats them as distances
#Inspect community membership
igraph::groups(got.edge)
## $`1`
## [1] "Arryn"
##
## $`2`
## [1] "Tully"
##
## $`3`
## [1] "Vale"
##
## $`4`
## [1] "Baratheon"
##
## $`5`
## [1] "Lannister"
##
## $`6`
## [1] "Martell"
##
## $`7`
## [1] "Reach"
##
## $`8`
## [1] "Stark"
##
## $`9`
## [1] "Stormlands"
##
## $`10`
## [1] "Tyrell"
##
## $`11`
## [1] "Crownlands"
##
## $`12`
## [1] "Essos"
##
## $`13`
## [1] "Riverlands"
##
## $`14`
## [1] "Westerlands"
##
## $`15`
## [1] "Frey"
##
## $`16`
## [1] "North"
##
## $`17`
## [1] "Targaryen"
##
## $`18`
## [1] "Dorne"
#inspect density of between/within community ties
print(blockmodel(gotmarr.stat,got.edge$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 NaN 1 1 0 0 0 0 0
## Block 2 1 NaN 1 0 0 0 0 1
## Block 3 1 1 NaN 0 0 0 0 1
## Block 4 0 0 0 NaN 1 1 1 1
## Block 5 0 0 0 1 NaN 0 1 1
## Block 6 0 0 0 1 0 NaN 0 0
## Block 7 0 0 0 1 1 0 NaN 0
## Block 8 0 1 1 1 1 0 0 NaN
## Block 9 0 0 0 1 0 0 1 0
## Block 10 0 0 0 1 0 0 1 0
## Block 11 0 0 0 0 0 0 0 1
## Block 12 0 0 0 0 0 1 0 0
## Block 13 0 1 0 0 0 0 1 1
## Block 14 0 0 0 0 1 0 1 1
## Block 15 0 1 1 0 1 0 1 0
## Block 16 0 0 0 0 0 0 1 1
## Block 17 1 0 1 1 0 1 1 1
## Block 18 0 0 0 0 0 0 0 0
## Block 9 Block 10 Block 11 Block 12 Block 13 Block 14 Block 15
## Block 1 0 0 0 0 0 0 0
## Block 2 0 0 0 0 1 0 1
## Block 3 0 0 0 0 0 0 1
## Block 4 1 1 0 0 0 0 0
## Block 5 0 0 0 0 0 1 1
## Block 6 0 0 0 1 0 0 0
## Block 7 1 1 0 0 1 1 1
## Block 8 0 0 1 0 1 1 0
## Block 9 NaN 0 0 0 0 0 1
## Block 10 0 NaN 0 0 0 0 0
## Block 11 0 0 NaN 1 1 1 1
## Block 12 0 0 1 NaN 0 0 1
## Block 13 0 0 1 0 NaN 0 1
## Block 14 0 0 1 0 0 NaN 1
## Block 15 1 0 1 1 1 1 NaN
## Block 16 0 0 0 0 0 0 1
## Block 17 1 0 1 1 1 1 0
## Block 18 0 0 0 0 0 0 0
## Block 16 Block 17 Block 18
## Block 1 0 1 0
## Block 2 0 0 0
## Block 3 0 1 0
## Block 4 0 1 0
## Block 5 0 0 0
## Block 6 0 1 0
## Block 7 1 1 0
## Block 8 1 1 0
## Block 9 0 1 0
## Block 10 0 0 0
## Block 11 0 1 0
## Block 12 0 1 0
## Block 13 0 1 0
## Block 14 0 1 0
## Block 15 1 0 0
## Block 16 NaN 0 0
## Block 17 0 NaN 1
## Block 18 0 1 NaN
#add community membership as a vertex attribute
gotmarr.nodes$comm.edge<-got.edge$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.edge")
## comm.edge degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 3 10 -1.113 0.67 0.50 0.51 0.115
## [2,] 2 5 5 -1.042 2.31 0.53 0.48 0.187
## [3,] 3 5 34 -1.085 2.51 0.57 0.36 0.201
## [4,] 4 7 10 -0.757 10.86 0.63 0.38 0.247
## [5,] 5 5 22 -0.086 0.89 0.55 0.65 0.226
## [6,] 6 3 8 -0.699 0.75 0.52 0.74 0.118
## [7,] 7 9 46 -1.442 15.76 0.68 0.32 0.323
## [8,] 8 9 33 0.057 13.56 0.68 0.40 0.328
## [9,] 9 4 10 -1.941 0.62 0.57 0.41 0.192
## [10,] 10 2 11 -0.685 0.00 0.45 0.66 0.085
## [11,] 11 6 17 -0.514 1.80 0.59 0.50 0.262
## [12,] 12 4 10 -0.956 2.15 0.55 0.70 0.164
## [13,] 13 6 32 -1.171 2.85 0.61 0.46 0.271
## [14,] 14 6 28 -0.214 1.97 0.61 0.49 0.277
## [15,] 15 10 48 -1.513 17.98 0.68 0.24 0.336
## [16,] 16 3 39 -0.628 0.31 0.50 0.65 0.147
## [17,] 17 12 73 -1.256 42.02 0.77 0.18 0.382
## [18,] 18 1 2 -0.500 0.00 0.45 1.00 0.057
## eigen.rc eigen.dc comm.fg comm.wt comm.lab n
## [1,] 0.0161 0.099 1 1 1 1
## [2,] 0.0078 0.179 1 1 1 1
## [3,] 0.0315 0.170 1 1 1 1
## [4,] 0.0231 0.224 3 3 3 1
## [5,] 0.0921 0.133 5 5 5 1
## [6,] 0.0113 0.107 2 2 2 1
## [7,] 0.0647 0.258 3 3 3 1
## [8,] 0.1635 0.165 6 4 4 1
## [9,] 0.0187 0.173 4 1 1 1
## [10,] 0.0301 0.055 3 3 3 1
## [11,] 0.0430 0.219 2 2 2 1
## [12,] 0.0224 0.141 2 2 2 1
## [13,] 0.0734 0.198 4 1 1 1
## [14,] 0.0985 0.179 5 5 5 1
## [15,] 0.1367 0.199 4 1 1 1
## [16,] 0.0655 0.082 6 4 4 1
## [17,] 0.1260 0.255 2 2 2 1
## [18,] 0.0029 0.054 2 2 2 1
#plot the network with community coloring
plot(got.edge,gotmarr.ig)
#collect modularity scores to compare
got.mods<-c(got.mods, edge=modularity(got.edge))
got.mods
## fastgreedy walktrap label edge
## 0.5173683 0.3289444 0.3289444 0.2051354
#compare community partitions
compare.algs(alg.a=c("got.fg","got.wt", "got.lab"),alg.b="got.edge")
## alg.a alg.b meth result
## 1 got.fg got.edge vi 1.1504049
## 2 got.wt got.edge vi 1.3814540
## 3 got.lab got.edge vi 1.3814540
## 4 got.fg got.edge nmi 0.7515506
## 5 got.wt got.edge nmi 0.6859825
## 6 got.lab got.edge nmi 0.6859825
## 7 got.fg got.edge split.join 12.0000000
## 8 got.wt got.edge split.join 13.0000000
## 9 got.lab got.edge split.join 13.0000000
## 10 got.fg got.edge rand 0.8627451
## 11 got.wt got.edge rand 0.8039216
## 12 got.lab got.edge rand 0.8039216
## 13 got.fg got.edge adjusted.rand 0.0000000
## 14 got.wt got.edge adjusted.rand 0.0000000
## 15 got.lab got.edge adjusted.rand 0.0000000
#alliances
alliances.edge<-edge.betweenness.community(alliances.ig)
## Warning in edge.betweenness.community(alliances.ig): At community.c:
## 460 :Membership vector will be selected based on the lowest modularity
## score.
## Warning in edge.betweenness.community(alliances.ig): At community.c:
## 467 :Modularity calculation with weighted edge betweenness community
## detection might not make sense -- modularity treats edge weights as
## similarities while edge betwenness treats them as distances
igraph::groups(alliances.edge)
## $`1`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Spain" "Greece"
## [9] "Turkey" "Poland"
## [11] "Hungary" "Luxembourg"
## [13] "Portugal" "German Federal Republic"
## [15] "Czech Republic" "Norway"
## [17] "Denmark" "Iceland"
##
## $`2`
## [1] "Russia" "Iran" "Latvia" "Pakistan"
## [5] "China" "Afghanistan" "India" "Moldova"
## [9] "Ukraine" "Belarus" "Armenia" "Georgia"
## [13] "Azerbaijan" "Turkmenistan" "Tajikistan" "Kyrgyzstan"
## [17] "Uzbekistan" "Slovakia" "Lithuania" "Kazakhstan"
## [21] "Finland" "Mongolia"
##
## $`3`
## [1] "Paraguay" "Brazil"
## [3] "Ecuador" "Peru"
## [5] "Colombia" "Argentina"
## [7] "Bolivia" "Guatemala"
## [9] "Honduras" "El Salvador"
## [11] "Nicaragua" "United States of America"
## [13] "Haiti" "Dominican Republic"
## [15] "Mexico" "Costa Rica"
## [17] "Panama" "Venezuela"
## [19] "Chile" "Canada"
## [21] "Bahamas" "Jamaica"
## [23] "Trinidad and Tobago" "Barbados"
## [25] "Dominica" "Grenada"
## [27] "St. Lucia" "St. Vincent and the Grenadines"
## [29] "Antigua & Barbuda" "St. Kitts and Nevis"
## [31] "Belize" "Guyana"
## [33] "Suriname" "Uruguay"
##
## $`4`
## [1] "Yugoslavia" "Croatia"
## [3] "Bosnia and Herzegovina"
##
## $`5`
## [1] "Bulgaria" "Romania" "Albania"
##
## $`6`
## [1] "Estonia"
##
## $`7`
## [1] "Saudi Arabia" "Iraq" "Mauritania"
## [4] "Somalia" "Djibouti" "Morocco"
## [7] "Algeria" "Tunisia" "Libya"
## [10] "Sudan" "Egypt" "Syria"
## [13] "Lebanon" "Jordan" "Yemen"
## [16] "Kuwait" "Bahrain" "Qatar"
## [19] "United Arab Emirates" "Oman" "Israel"
##
## $`8`
## [1] "Japan"
##
## $`9`
## [1] "Australia"
##
## $`10`
## [1] "Philippines"
##
## $`11`
## [1] "Central African Republic" "Chad"
## [3] "Cameroon" "Gabon"
## [5] "Congo" "Rwanda"
## [7] "Kenya" "Democratic Republic of the Congo"
## [9] "Burundi" "Uganda"
## [11] "Angola" "Sao Tome and Principe"
## [13] "Equatorial Guinea" "Tanzania"
## [15] "Zambia"
##
## $`12`
## [1] "Mali" "Guinea" "Senegal" "Benin"
## [5] "Niger" "Ivory Coast" "Burkina Faso" "Togo"
## [9] "Cape Verde" "Guinea-Bissau" "Gambia" "Liberia"
## [13] "Sierra Leone" "Ghana" "Nigeria"
##
## $`13`
## [1] "Ethiopia" "Eritrea"
##
## $`14`
## [1] "South Africa" "Swaziland"
##
## $`15`
## [1] "North Korea" "South Korea"
print(blockmodel(alliances.stat,alliances.edge$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.9477 0.0354 0.0556 0.019 0.093 0.056 0.0000 0.000
## Block 2 0.0354 0.4242 0.0027 0.000 0.045 0.000 0.0022 0.000
## Block 3 0.0556 0.0027 1.0000 0.000 0.000 0.000 0.0000 0.029
## Block 4 0.0185 0.0000 0.0000 1.000 0.000 0.000 0.0000 0.000
## Block 5 0.0926 0.0455 0.0000 0.000 0.667 0.000 0.0000 0.000
## Block 6 0.0556 0.0000 0.0000 0.000 0.000 NaN 0.0000 0.000
## Block 7 0.0000 0.0022 0.0000 0.000 0.000 0.000 0.9143 0.000
## Block 8 0.0000 0.0000 0.0294 0.000 0.000 0.000 0.0000 NaN
## Block 9 0.0000 0.0000 0.0294 0.000 0.000 0.000 0.0000 0.000
## Block 10 0.0000 0.0000 0.0294 0.000 0.000 0.000 0.0000 0.000
## Block 11 0.0037 0.0000 0.0000 0.000 0.000 0.000 0.0349 0.000
## Block 12 0.0000 0.0000 0.0020 0.000 0.000 0.000 0.0000 0.000
## Block 13 0.0000 0.0000 0.0000 0.000 0.000 0.000 0.0000 0.000
## Block 14 0.0000 0.0000 0.0000 0.000 0.000 0.000 0.0000 0.000
## Block 15 0.0000 0.0455 0.0147 0.000 0.000 0.000 0.0000 0.000
## Block 9 Block 10 Block 11 Block 12 Block 13 Block 14 Block 15
## Block 1 0.000 0.000 0.0037 0.000 0.000 0 0.000
## Block 2 0.000 0.000 0.0000 0.000 0.000 0 0.045
## Block 3 0.029 0.029 0.0000 0.002 0.000 0 0.015
## Block 4 0.000 0.000 0.0000 0.000 0.000 0 0.000
## Block 5 0.000 0.000 0.0000 0.000 0.000 0 0.000
## Block 6 0.000 0.000 0.0000 0.000 0.000 0 0.000
## Block 7 0.000 0.000 0.0349 0.000 0.000 0 0.000
## Block 8 0.000 0.000 0.0000 0.000 0.000 0 0.000
## Block 9 NaN 0.000 0.0000 0.000 0.000 0 0.000
## Block 10 0.000 NaN 0.0000 0.000 0.000 0 0.000
## Block 11 0.000 0.000 0.8095 0.000 0.033 0 0.000
## Block 12 0.000 0.000 0.0000 1.000 0.000 0 0.000
## Block 13 0.000 0.000 0.0333 0.000 1.000 0 0.000
## Block 14 0.000 0.000 0.0000 0.000 0.000 1 0.000
## Block 15 0.000 0.000 0.0000 0.000 0.000 0 1.000
alliances.nodes$comm.edge<-alliances.edge$membership
nodes.by.gp(alliances.nodes,"comm.edge")
## comm.edge degree degree.wt betweenness close constraint eigen
## [1,] 1 38.4 23.6 407 0.4600 0.18 2.1e-02
## [2,] 2 19.8 15.6 466 0.3764 0.38 1.4e-03
## [3,] 3 68.4 36.5 307 0.4881 0.11 1.7e-01
## [4,] 4 4.7 2.3 181 0.2741 0.88 2.3e-04
## [5,] 5 8.0 4.0 15 0.3392 0.40 1.3e-03
## [6,] 6 2.0 1.0 0 0.3148 1.00 6.6e-04
## [7,] 7 37.7 34.3 250 0.3467 0.22 1.8e-06
## [8,] 8 2.0 1.0 0 0.3624 1.00 5.5e-03
## [9,] 9 2.0 1.0 0 0.3624 1.00 5.5e-03
## [10,] 10 2.0 1.0 0 0.3624 1.00 5.5e-03
## [11,] 11 24.4 14.5 413 0.3502 0.28 6.5e-05
## [12,] 12 28.1 14.2 231 0.3398 0.26 6.3e-04
## [13,] 13 3.0 1.5 137 0.2099 0.75 9.4e-08
## [14,] 14 2.0 1.0 0 0.0071 1.00 7.5e-64
## [15,] 15 5.0 2.5 60 0.3544 0.43 3.0e-03
## eigen.rc eigen.dc comm.fg comm.wt comm.lab n
## [1,] 9.3e-04 2.0e-02 3.0 3.0 3.0 18
## [2,] 9.4e-05 1.3e-03 2.0 1.1 1.1 22
## [3,] 5.1e-03 1.7e-01 7.7 4.0 4.0 34
## [4,] 2.9e-05 2.0e-04 4.0 5.0 5.0 3
## [5,] 8.8e-05 1.2e-03 2.0 3.0 3.0 3
## [6,] 2.5e-05 6.3e-04 3.0 3.0 3.0 1
## [7,] 9.5e-08 1.7e-06 5.8 7.0 7.0 21
## [8,] 9.8e-05 5.4e-03 3.0 4.0 4.0 1
## [9,] 9.8e-05 5.4e-03 3.0 4.0 4.0 1
## [10,] 9.8e-05 5.4e-03 3.0 4.0 4.0 1
## [11,] 4.7e-06 6.0e-05 1.0 6.0 6.0 15
## [12,] 4.1e-05 5.9e-04 7.0 8.0 8.0 15
## [13,] 1.6e-08 7.7e-08 1.0 2.0 2.0 2
## [14,] 7.5e-64 0.0e+00 5.0 9.0 9.0 2
## [15,] 1.1e-04 2.9e-03 2.0 1.0 1.0 2
plot(alliances.edge,alliances.ig)
alliances.mods<-c(alliances.mods, edge=modularity(alliances.edge))
alliances.mods
## fastgreedy walktrap label edge
## 0.6992952 0.7130571 0.7130571 0.7083932
compare.algs(alg.a=c("alliances.fg","alliances.wt", "alliances.lab"), alg.b="alliances.edge")
## alg.a alg.b meth result
## 1 alliances.fg alliances.edge vi 0.4312711
## 2 alliances.wt alliances.edge vi 0.2933660
## 3 alliances.lab alliances.edge vi 0.2933660
## 4 alliances.fg alliances.edge nmi 0.8926180
## 5 alliances.wt alliances.edge nmi 0.9275088
## 6 alliances.lab alliances.edge nmi 0.9275088
## 7 alliances.fg alliances.edge split.join 17.0000000
## 8 alliances.wt alliances.edge split.join 11.0000000
## 9 alliances.lab alliances.edge split.join 11.0000000
## 10 alliances.fg alliances.edge rand 0.9626140
## 11 alliances.wt alliances.edge rand 0.9731510
## 12 alliances.lab alliances.edge rand 0.9731510
## 13 alliances.fg alliances.edge adjusted.rand 0.8530167
## 14 alliances.wt alliances.edge adjusted.rand 0.8951062
## 15 alliances.lab alliances.edge adjusted.rand 0.8951062
#airport flights
airports.edge<-edge.betweenness.community(as.undirected(airports.fl.ig),weights=NULL)
igraph::groups(airports.edge)
## $`1`
## [1] "ABE" "ABQ" "ACY" "ALB" "ATL" "AUS" "BDL" "BHM" "BNA" "BOS" "BTV"
## [12] "BUF" "BUR" "BWI" "CAE" "CAK" "CHS" "CID" "CLE" "CLT" "CMH" "COS"
## [23] "CRW" "CVG" "DAL" "DAY" "DCA" "DEN" "DFW" "DSM" "DTW" "EGE" "ELP"
## [34] "EWR" "FLL" "GPT" "GRR" "GSO" "GSP" "HNL" "HOU" "HPN" "HSV" "IAD"
## [45] "IAH" "ICT" "IND" "JAN" "JAX" "JFK" "LAS" "LAX" "LEX" "LGA" "LGB"
## [56] "LIT" "MCI" "MCO" "MDT" "MDW" "MEM" "MHT" "MIA" "MKE" "MLI" "MSN"
## [67] "MSP" "MSY" "OAK" "OKC" "OMA" "ONT" "ORD" "ORF" "PBI" "PDX" "PHL"
## [78] "PHX" "PIT" "PVD" "PWM" "RDU" "RIC" "RNO" "ROC" "RSW" "SAN" "SAT"
## [89] "SAV" "SBN" "SDF" "SEA" "SFO" "SJC" "SJU" "SLC" "SMF" "SNA" "STL"
## [100] "STT" "SYR" "TPA" "TUL" "TUS" "TYS" "XNA"
##
## $`2`
## [1] "AGS"
##
## $`3`
## [1] "AMA"
##
## $`4`
## [1] "ANC"
##
## $`5`
## [1] "ASE"
##
## $`6`
## [1] "ATW"
##
## $`7`
## [1] "AVL"
##
## $`8`
## [1] "AVP"
##
## $`9`
## [1] "AZA"
##
## $`10`
## [1] "AZO"
##
## $`11`
## [1] "BET"
##
## $`12`
## [1] "BGR"
##
## $`13`
## [1] "BIL"
##
## $`14`
## [1] "BIS"
##
## $`15`
## [1] "BLI"
##
## $`16`
## [1] "BMI"
##
## $`17`
## [1] "BOI"
##
## $`18`
## [1] "BQN"
##
## $`19`
## [1] "BTR"
##
## $`20`
## [1] "BZN"
##
## $`21`
## [1] "CHA"
##
## $`22`
## [1] "CHO"
##
## $`23`
## [1] "CRP"
##
## $`24`
## [1] "DAB"
##
## $`25`
## [1] "DRO"
##
## $`26`
## [1] "ECP"
##
## $`27`
## [1] "ELM"
##
## $`28`
## [1] "EUG"
##
## $`29`
## [1] "EVV"
##
## $`30`
## [1] "EYW"
##
## $`31`
## [1] "FAI"
##
## $`32`
## [1] "FAR"
##
## $`33`
## [1] "FAT"
##
## $`34`
## [1] "FAY"
##
## $`35`
## [1] "FNT"
##
## $`36`
## [1] "FSD"
##
## $`37`
## [1] "FWA"
##
## $`38`
## [1] "GEG"
##
## $`39`
## [1] "GJT"
##
## $`40`
## [1] "GNV"
##
## $`41`
## [1] "GRB"
##
## $`42`
## [1] "GRK"
##
## $`43`
## [1] "GTF"
##
## $`44`
## [1] "GUM"
##
## $`45`
## [1] "HRL"
##
## $`46`
## [1] "IDA"
##
## $`47`
## [1] "ILM"
##
## $`48`
## [1] "ISP"
##
## $`49`
## [1] "ITO"
##
## $`50`
## [1] "JAC"
##
## $`51`
## [1] "JNU" "KTN"
##
## $`52`
## [1] "KOA"
##
## $`53`
## [1] "LBB"
##
## $`54`
## [1] "LFT"
##
## $`55`
## [1] "LIH"
##
## $`56`
## [1] "MAF"
##
## $`57`
## [1] "MFE"
##
## $`58`
## [1] "MFR"
##
## $`59`
## [1] "MGM"
##
## $`60`
## [1] "MLB"
##
## $`61`
## [1] "MOB"
##
## $`62`
## [1] "MRY"
##
## $`63`
## [1] "MSO"
##
## $`64`
## [1] "MYR"
##
## $`65`
## [1] "OAJ"
##
## $`66`
## [1] "OGG"
##
## $`67`
## [1] "PGD"
##
## $`68`
## [1] "PHF"
##
## $`69`
## [1] "PIA"
##
## $`70`
## [1] "PIE"
##
## $`71`
## [1] "PNS"
##
## $`72`
## [1] "PSC"
##
## $`73`
## [1] "PSP"
##
## $`74`
## [1] "RAP"
##
## $`75`
## [1] "RDM"
##
## $`76`
## [1] "ROA"
##
## $`77`
## [1] "SBA"
##
## $`78`
## [1] "SCE"
##
## $`79`
## [1] "SFB"
##
## $`80`
## [1] "SGF"
##
## $`81`
## [1] "SHV"
##
## $`82`
## [1] "SRQ"
##
## $`83`
## [1] "STX"
##
## $`84`
## [1] "SWF"
##
## $`85`
## [1] "TLH"
##
## $`86`
## [1] "TRI"
##
## $`87`
## [1] "VPS"
print(blockmodel(airports.fl.stat,airports.edge$membership)$block.model[1:10,1:10], digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.351 0.038 0.066 0.094 0.057 0.085 0.075 0.085
## Block 2 0.028 NaN 0.000 0.000 0.000 0.000 0.000 0.000
## Block 3 0.075 0.000 NaN 0.000 0.000 0.000 0.000 0.000
## Block 4 0.094 0.000 0.000 NaN 0.000 0.000 0.000 0.000
## Block 5 0.057 0.000 0.000 0.000 NaN 0.000 0.000 0.000
## Block 6 0.075 0.000 0.000 0.000 0.000 NaN 0.000 0.000
## Block 7 0.075 0.000 0.000 0.000 0.000 0.000 NaN 0.000
## Block 8 0.075 0.000 0.000 0.000 0.000 0.000 0.000 NaN
## Block 9 0.113 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Block 10 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Block 9 Block 10
## Block 1 0.13 0.038
## Block 2 0.00 0.000
## Block 3 0.00 0.000
## Block 4 0.00 0.000
## Block 5 0.00 0.000
## Block 6 0.00 0.000
## Block 7 0.00 0.000
## Block 8 0.00 0.000
## Block 9 NaN 0.000
## Block 10 0.00 NaN
airports.fl.mods<-c(airports.fl.mods,modularity(airports.edge))
airports.geo.mods<-c(airports.geo.mods,modularity(airports.edge))
The leading eigenvector community detection method is based on the eigenvectors of the modularity matrix of the network. It has a few options such as steps and start that might be useful, but are not typically used. A weighted network can be used with the standards weights opton or an appropriately named “weights” edge attribute.
#Run clustering algorithm: leading eigenvector
comm.eigen<-leading.eigenvector.community(flomarr.ig)
#Inspect community membership
igraph::groups(comm.eigen)
## $`1`
## [1] "Acciaiuoli" "Barbadori" "Medici" "Pazzi" "Ridolfi"
## [6] "Salviati"
##
## $`2`
## [1] "Pucci"
##
## $`3`
## [1] "Bischeri" "Castellani" "Peruzzi" "Strozzi"
##
## $`4`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
## [5] "Tornabuoni"
We can describe and plot the leading eigenvector communities.
#inspect density of between/within community ties
print(blockmodel(flomarr.stat,comm.eigen$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.333 0 0.083 0.10
## Block 2 0.000 NaN 0.000 0.00
## Block 3 0.083 0 0.833 0.05
## Block 4 0.100 0 0.050 0.40
#add community membership as a vertex attribute
flomarr.nodes$comm.eigen<-comm.eigen$membership
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.eigen")
## comm.eigen degree betweenness close constraint eigen eigen.rc
## [1,] 1 2.5 13.2 0 0.61 0.22 0.066
## [2,] 2 0.0 0.0 0 0.00 0.00 NaN
## [3,] 3 3.2 6.5 0 0.52 0.29 0.091
## [4,] 4 2.4 10.2 0 0.61 0.20 0.061
## eigen.dc comm.fg comm.wt comm.lab comm.edge n
## [1,] 0.15 1.3 2.8 1.2 1.2 6
## [2,] NaN 4.0 5.0 3.0 3.0 1
## [3,] 0.20 3.0 3.0 2.0 2.0 4
## [4,] 0.14 1.8 1.2 1.0 1.0 5
#plot network with community coloring
plot(comm.eigen,flomarr.ig)
Compare the various community partitions created so far by adding to the modularity index and using our custom function.
#collect modularity scores to compare
mods<-c(mods, eigen=modularity(comm.eigen))
mods
## fastgreedy walktrap label edge eigen
## 0.4410431 0.3922902 0.3730159 0.3730159 0.4070295
#compare community partitions
compare.algs(alg.a=c("comm.fg","comm.wt", "comm.lab", "comm.edge"), alg.b="comm.eigen")
## alg.a alg.b meth result
## 1 comm.fg comm.eigen vi 0.6506724
## 2 comm.wt comm.eigen vi 0.8326119
## 3 comm.lab comm.eigen vi 0.7585532
## 4 comm.edge comm.eigen vi 0.7585532
## 5 comm.fg comm.eigen nmi 0.7399715
## 6 comm.wt comm.eigen nmi 0.6962384
## 7 comm.lab comm.eigen nmi 0.6356052
## 8 comm.edge comm.eigen nmi 0.6356052
## 9 comm.fg comm.eigen split.join 4.0000000
## 10 comm.wt comm.eigen split.join 6.0000000
## 11 comm.lab comm.eigen split.join 7.0000000
## 12 comm.edge comm.eigen split.join 7.0000000
## 13 comm.fg comm.eigen rand 0.8500000
## 14 comm.wt comm.eigen rand 0.8166667
## 15 comm.lab comm.eigen rand 0.7166667
## 16 comm.edge comm.eigen rand 0.7166667
## 17 comm.fg comm.eigen adjusted.rand 0.6085538
## 18 comm.wt comm.eigen adjusted.rand 0.4776415
## 19 comm.lab comm.eigen adjusted.rand 0.4095514
## 20 comm.edge comm.eigen adjusted.rand 0.4095514
Repeat the basic community analysis routine for one of the other datasets provided this week.
#Run clustering algorithm: leading eigenvector
#Inspect community membership
#inspect density of between/within community ties
#add community membership as a vertex attribute
#summarize node statistics by community
#plot the network with community coloring
#compare modularity scores
#compare community partitions
#Run clustering algorithm: leading eigenvector
got.eigen<-leading.eigenvector.community(gotmarr.ig)
#Inspect community membership
igraph::groups(got.eigen)
## $`1`
## [1] "Arryn" "Baratheon" "Martell" "Stormlands" "Crownlands"
## [6] "Essos" "Targaryen" "Dorne"
##
## $`2`
## [1] "Tully" "Vale" "Riverlands" "Frey"
##
## $`3`
## [1] "Reach"
##
## $`4`
## [1] "Stark" "North"
##
## $`5`
## [1] "Lannister" "Westerlands"
##
## $`6`
## [1] "Tyrell"
#inspect density of between/within community ties
print(blockmodel(gotmarr.stat,got.eigen$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6
## Block 1 0.39 0.25 0.38 0.19 0.19 0.12
## Block 2 0.25 0.83 0.50 0.50 0.25 0.00
## Block 3 0.38 0.50 NaN 0.50 1.00 1.00
## Block 4 0.19 0.50 0.50 1.00 0.50 0.00
## Block 5 0.19 0.25 1.00 0.50 1.00 0.00
## Block 6 0.12 0.00 1.00 0.00 0.00 NaN
#add community membership as a vertex attribute
gotmarr.nodes$comm.eigen<-got.eigen$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.eigen")
## comm.eigen degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 5.0 18 -0.97 7.4 0.57 0.55 0.192
## [2,] 2 6.5 30 -1.20 6.4 0.60 0.38 0.249
## [3,] 3 9.0 46 -1.44 15.8 0.68 0.32 0.323
## [4,] 4 6.0 36 -0.29 6.9 0.59 0.53 0.238
## [5,] 5 5.5 25 -0.15 1.4 0.58 0.57 0.251
## [6,] 6 2.0 11 -0.69 0.0 0.45 0.66 0.085
## eigen.rc eigen.dc comm.fg comm.wt comm.lab comm.edge n
## [1,] 0.033 0.159 2.2 1.9 1.9 9.8 8
## [2,] 0.062 0.186 2.5 1.0 1.0 8.2 4
## [3,] 0.065 0.258 3.0 3.0 3.0 7.0 1
## [4,] 0.114 0.123 6.0 4.0 4.0 12.0 2
## [5,] 0.095 0.156 5.0 5.0 5.0 9.5 2
## [6,] 0.030 0.055 3.0 3.0 3.0 10.0 1
#plot the network with community coloring
plot(got.eigen,gotmarr.ig)
#collect modularity scores to compare
got.mods<-c(got.mods, eigen=modularity(got.eigen))
got.mods
## fastgreedy walktrap label edge eigen
## 0.5173683 0.3289444 0.3289444 0.2051354 0.4572361
#compare community partitions
compare.algs(alg.a=c("got.fg","got.wt", "got.lab", "got.edge"), alg.b="got.eigen")
## alg.a alg.b meth result
## 1 got.fg got.eigen vi 1.0264363
## 2 got.wt got.eigen vi 0.7953872
## 3 got.lab got.eigen vi 0.7953872
## 4 got.edge got.eigen vi 1.3862944
## 5 got.fg got.eigen nmi 0.6835936
## 6 got.wt got.eigen nmi 0.7360144
## 7 got.lab got.eigen nmi 0.7360144
## 8 got.edge got.eigen nmi 0.6845351
## 9 got.fg got.eigen split.join 9.0000000
## 10 got.wt got.eigen split.join 7.0000000
## 11 got.lab got.eigen split.join 7.0000000
## 12 got.edge got.eigen split.join 12.0000000
## 13 got.fg got.eigen rand 0.8104575
## 14 got.wt got.eigen rand 0.8169935
## 15 got.lab got.eigen rand 0.8169935
## 16 got.edge got.eigen rand 0.7647059
## 17 got.fg got.eigen adjusted.rand 0.3845194
## 18 got.wt got.eigen adjusted.rand 0.4603175
## 19 got.lab got.eigen adjusted.rand 0.4603175
## 20 got.edge got.eigen adjusted.rand 0.0000000
#alliances
alliances.eigen<-leading.eigenvector.community(alliances.ig)
igraph::groups(alliances.eigen)
## $`1`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Russia" "Spain"
## [9] "Paraguay" "Brazil"
## [11] "Ecuador" "Peru"
## [13] "Colombia" "Argentina"
## [15] "Bolivia" "Yugoslavia"
## [17] "Guatemala" "Honduras"
## [19] "El Salvador" "Nicaragua"
## [21] "United States of America" "Greece"
## [23] "Bulgaria" "Romania"
## [25] "Turkey" "Poland"
## [27] "Iran" "Estonia"
## [29] "Hungary" "Saudi Arabia"
## [31] "Latvia" "Iraq"
## [33] "Haiti" "Dominican Republic"
## [35] "Mexico" "Costa Rica"
## [37] "Panama" "Venezuela"
## [39] "Chile" "Japan"
## [41] "Australia" "Mauritania"
## [43] "Somalia" "Djibouti"
## [45] "Morocco" "Algeria"
## [47] "Tunisia" "Libya"
## [49] "Sudan" "Egypt"
## [51] "Syria" "Lebanon"
## [53] "Jordan" "Yemen"
## [55] "Kuwait" "Bahrain"
## [57] "Qatar" "United Arab Emirates"
## [59] "Albania" "Canada"
## [61] "Bahamas" "Jamaica"
## [63] "Trinidad and Tobago" "Barbados"
## [65] "Dominica" "Grenada"
## [67] "St. Lucia" "St. Vincent and the Grenadines"
## [69] "Antigua & Barbuda" "St. Kitts and Nevis"
## [71] "Belize" "Guyana"
## [73] "Suriname" "Luxembourg"
## [75] "Portugal" "German Federal Republic"
## [77] "Czech Republic" "Norway"
## [79] "Denmark" "Iceland"
## [81] "Pakistan" "Philippines"
## [83] "China" "Central African Republic"
## [85] "Chad" "Afghanistan"
## [87] "Mali" "Guinea"
## [89] "Senegal" "Benin"
## [91] "Niger" "Ivory Coast"
## [93] "Burkina Faso" "Togo"
## [95] "Cameroon" "Gabon"
## [97] "Congo" "Rwanda"
## [99] "India" "Kenya"
## [101] "Democratic Republic of the Congo" "Burundi"
## [103] "Uganda" "Cape Verde"
## [105] "Guinea-Bissau" "Gambia"
## [107] "Liberia" "Sierra Leone"
## [109] "Ghana" "Angola"
## [111] "Ethiopia" "North Korea"
## [113] "Moldova" "Ukraine"
## [115] "Belarus" "Armenia"
## [117] "Georgia" "Azerbaijan"
## [119] "Turkmenistan" "Tajikistan"
## [121] "Kyrgyzstan" "Uzbekistan"
## [123] "Croatia" "Slovakia"
## [125] "Lithuania" "Kazakhstan"
## [127] "Sao Tome and Principe" "Equatorial Guinea"
## [129] "Tanzania" "Zambia"
## [131] "Uruguay" "Finland"
## [133] "Mongolia" "Oman"
## [135] "South Korea" "Israel"
## [137] "Nigeria" "Bosnia and Herzegovina"
## [139] "Eritrea"
##
## $`2`
## [1] "South Africa" "Swaziland"
print(blockmodel(alliances.stat,alliances.eigen$membership)$block.model, digits=2)
## Block 1 Block 2
## Block 1 0.13 0
## Block 2 0.00 1
alliances.nodes$comm.eigen<-alliances.eigen$membership
nodes.by.gp(alliances.nodes,"comm.eigen")
## comm.eigen degree degree.wt betweenness close constraint eigen
## [1,] 1 37 23 316 0.3968 0.28 4.5e-02
## [2,] 2 2 1 0 0.0071 1.00 7.5e-64
## eigen.rc eigen.dc comm.fg comm.wt comm.lab comm.edge n
## [1,] 1.4e-03 0.044 4.6 4.4 4.4 5.6 139
## [2,] 7.5e-64 0.000 5.0 9.0 9.0 14.0 2
plot(alliances.eigen,alliances.ig)
alliances.mods<-c(alliances.mods, eigen=modularity(alliances.eigen))
alliances.mods
## fastgreedy walktrap label edge eigen
## 0.699295231 0.713057101 0.713057101 0.708393203 0.001252348
compare.algs(alg.a=c("alliances.fg","alliances.wt", "alliances.lab", "alliances.edge"), alg.b="alliances.eigen")
## alg.a alg.b meth result
## 1 alliances.fg alliances.eigen vi 1.800493e+00
## 2 alliances.wt alliances.eigen vi 1.831181e+00
## 3 alliances.lab alliances.eigen vi 1.831181e+00
## 4 alliances.edge alliances.eigen vi 2.066846e+00
## 5 alliances.fg alliances.eigen nmi 7.637955e-02
## 6 alliances.wt alliances.eigen nmi 7.519577e-02
## 7 alliances.lab alliances.eigen nmi 7.519577e-02
## 8 alliances.edge alliances.eigen nmi 6.719800e-02
## 9 alliances.fg alliances.eigen split.join 1.070000e+02
## 10 alliances.wt alliances.eigen split.join 1.020000e+02
## 11 alliances.lab alliances.eigen split.join 1.020000e+02
## 12 alliances.edge alliances.eigen split.join 1.050000e+02
## 13 alliances.fg alliances.eigen rand 1.877406e-01
## 14 alliances.wt alliances.eigen rand 1.899696e-01
## 15 alliances.lab alliances.eigen rand 1.899696e-01
## 16 alliances.edge alliances.eigen rand 1.673759e-01
## 17 alliances.fg alliances.eigen adjusted.rand 1.094577e-02
## 18 alliances.wt alliances.eigen adjusted.rand 1.112717e-02
## 19 alliances.lab alliances.eigen adjusted.rand 1.112717e-02
## 20 alliances.edge alliances.eigen adjusted.rand 9.330545e-03
#airport flights
airports.fl.eigen<-leading.eigenvector.community(airports.fl.ig)
## Warning in leading.eigenvector.community(airports.fl.ig): At community.c:
## 1597 :This method was developed for undirected graphs
igraph::groups(airports.fl.eigen)
## $`1`
## [1] "ABE" "ACY" "ALB" "ATW" "AVP" "AZO" "BDL" "BGR" "BMI" "BOS" "BQN"
## [12] "BTV" "BUF" "BWI" "CAK" "CHA" "CHO" "CHS" "CID" "CLE" "CLT" "CMH"
## [23] "CRW" "CVG" "DAY" "DCA" "DTW" "ELM" "EVV" "EWR" "EYW" "FLL" "FNT"
## [34] "FWA" "GRB" "GRR" "GSO" "HPN" "IAD" "ILM" "IND" "ISP" "LGA" "MCO"
## [45] "MDT" "MHT" "MIA" "MKE" "MLI" "MSN" "MYR" "ORD" "ORF" "PBI" "PHF"
## [56] "PHL" "PIA" "PIE" "PIT" "PVD" "PWM" "RDU" "RIC" "ROA" "ROC" "RSW"
## [67] "SBN" "SCE" "SFB" "SJU" "SRQ" "STL" "STT" "STX" "SWF" "SYR" "TLH"
## [78] "TPA" "TRI"
##
## $`2`
## [1] "ABQ" "AMA" "ANC" "ASE" "AUS" "AZA" "BET" "BIL" "BIS" "BLI" "BOI"
## [12] "BUR" "BZN" "COS" "CRP" "DAL" "DEN" "DFW" "DRO" "EGE" "ELP" "EUG"
## [23] "FAI" "FAR" "FAT" "FSD" "GEG" "GJT" "GTF" "GUM" "HNL" "HOU" "HRL"
## [34] "IDA" "ITO" "JAC" "JFK" "JNU" "KOA" "KTN" "LAS" "LAX" "LBB" "LGB"
## [45] "LIH" "MAF" "MCI" "MDW" "MFE" "MFR" "MRY" "MSO" "MSP" "OAK" "OGG"
## [56] "OKC" "OMA" "ONT" "PDX" "PHX" "PSC" "PSP" "RAP" "RDM" "RNO" "SAN"
## [67] "SAT" "SBA" "SEA" "SFO" "SJC" "SLC" "SMF" "SNA" "TUL" "TUS"
##
## $`3`
## [1] "AGS" "ATL" "AVL" "BHM" "BNA" "BTR" "CAE" "DAB" "DSM" "ECP" "FAY"
## [12] "GNV" "GPT" "GRK" "GSP" "HSV" "IAH" "ICT" "JAN" "JAX" "LEX" "LFT"
## [23] "LIT" "MEM" "MGM" "MLB" "MOB" "MSY" "OAJ" "PGD" "PNS" "SAV" "SDF"
## [34] "SGF" "SHV" "TYS" "VPS" "XNA"
print(blockmodel(airports.fl.stat,airports.fl.eigen$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3
## Block 1 0.253 0.084 0.126
## Block 2 0.084 0.229 0.071
## Block 3 0.130 0.075 0.160
airports.fl.nodes$comm.eigen<-airports.fl.eigen$membership
nodes.by.gp(airports.fl.nodes,"comm.eigen")
## comm.eigen degree degree.wt betweenness close constraint eigen
## [1,] 1 62 6810 173 0.52 0.19 0.064
## [2,] 2 53 6556 214 0.50 0.29 0.050
## [3,] 3 43 4987 184 0.50 0.25 0.047
## eigen.rc eigen.dc comm.fg comm.wt comm.lab n
## [1,] 0.00106 0.063 3.2 4.9 4.9 79
## [2,] 0.00088 0.049 2.1 2.3 2.3 76
## [3,] 0.00072 0.046 4.0 5.0 5.0 38
plot(airports.fl.eigen,airports.fl.ig)
airports.fl.mods<-c(airports.fl.mods, eigen=modularity(airports.fl.eigen))
airports.fl.mods
## fastgreedy walktrap label eigen
## 0.285292426 0.246254131 0.246254131 0.008841226 0.245978519
compare.algs(alg.a=c("airports.fl.fg","airports.fl.wt", "airports.fl.lab", "airports.edge"), alg.b="airports.fl.eigen")
## alg.a alg.b meth result
## 1 airports.fl.fg airports.fl.eigen vi 1.21911690
## 2 airports.fl.wt airports.fl.eigen vi 0.87125376
## 3 airports.fl.lab airports.fl.eigen vi 0.87125376
## 4 airports.edge airports.fl.eigen vi 2.77584854
## 5 airports.fl.fg airports.fl.eigen nmi 0.49121743
## 6 airports.fl.wt airports.fl.eigen nmi 0.55944336
## 7 airports.fl.lab airports.fl.eigen nmi 0.55944336
## 8 airports.edge airports.fl.eigen nmi 0.25914643
## 9 airports.fl.fg airports.fl.eigen split.join 97.00000000
## 10 airports.fl.wt airports.fl.eigen split.join 64.00000000
## 11 airports.fl.lab airports.fl.eigen split.join 64.00000000
## 12 airports.edge airports.fl.eigen split.join 142.00000000
## 13 airports.fl.fg airports.fl.eigen rand 0.76527418
## 14 airports.fl.wt airports.fl.eigen rand 0.73558938
## 15 airports.fl.lab airports.fl.eigen rand 0.73558938
## 16 airports.edge airports.fl.eigen rand 0.56401123
## 17 airports.fl.fg airports.fl.eigen adjusted.rand 0.47535341
## 18 airports.fl.wt airports.fl.eigen adjusted.rand 0.46486507
## 19 airports.fl.lab airports.fl.eigen adjusted.rand 0.46486507
## 20 airports.edge airports.fl.eigen adjusted.rand 0.01657597
#airport geography
airports.geo.eigen<-leading.eigenvector.community(airports.geo.ig)
## Warning in leading.eigenvector.community(airports.geo.ig): At community.c:
## 1597 :This method was developed for undirected graphs
igraph::groups(airports.geo.eigen)
## $`1`
## [1] "ABE" "ACY" "ALB" "AMA" "BDL" "BHM" "BNA" "BOS" "BTR" "BUF" "BWI"
## [12] "CAE" "CAK" "CHO" "CLE" "CLT" "CMH" "CRP" "CVG" "DAB" "DAL" "DCA"
## [23] "DTW" "ECP" "EYW" "FLL" "FNT" "GNV" "HOU" "IND" "ISP" "JAN" "JAX"
## [34] "LAX" "LGA" "LIT" "MCI" "MCO" "MDT" "MEM" "MIA" "MKE" "MSN" "MSY"
## [45] "MYR" "OMA" "ORF" "PBI" "PHF" "PHL" "PIT" "PNS" "RDU" "RIC" "ROC"
## [56] "RSW" "SAT" "SCE" "SJU" "SRQ" "STL" "STX" "SWF" "SYR" "TLH" "TPA"
## [67] "TUL" "VPS"
##
## $`2`
## [1] "ABQ" "AGS" "ANC" "ASE" "ATL" "AUS" "AVL" "BET" "BIL" "BLI" "BOI"
## [12] "BUR" "BZN" "COS" "DEN" "DFW" "DRO" "EGE" "ELP" "EUG" "EVV" "EWR"
## [23] "FAI" "FAR" "FAT" "FAY" "FWA" "GEG" "GJT" "GRK" "GUM" "HNL" "IAD"
## [34] "IAH" "IDA" "ITO" "JAC" "JFK" "JNU" "KOA" "KTN" "LBB" "LGB" "LIH"
## [45] "MAF" "MDW" "MFR" "MRY" "MSP" "OAJ" "OAK" "OGG" "OKC" "ONT" "ORD"
## [56] "PDX" "PHX" "PSP" "RAP" "RDM" "RNO" "SAN" "SBA" "SEA" "SFO" "SJC"
## [67] "SLC" "SMF" "SNA" "STT" "TUS"
##
## $`3`
## [1] "ATW" "AZA" "BGR" "BIS" "CID" "DSM" "FSD" "GRB" "GRR" "GTF" "HPN"
## [12] "HRL" "ICT" "LAS" "MFE" "MHT" "MLI" "MSO" "PIA" "PIE" "PSC" "PVD"
## [23] "SBN" "SDF" "SFB" "SGF" "SHV" "TRI" "XNA"
##
## $`4`
## [1] "AVP" "AZO" "BMI" "CHA" "DAY" "GPT" "GSO" "GSP" "ILM" "LEX" "MLB"
## [12] "PGD" "SAV" "TYS"
##
## $`5`
## [1] "BQN"
##
## $`6`
## [1] "CHS" "PWM"
##
## $`7`
## [1] "HSV"
##
## $`8`
## [1] "BTV"
##
## $`9`
## [1] "CRW"
##
## $`10`
## [1] "ROA"
##
## $`11`
## [1] "ELM"
##
## $`12`
## [1] "LFT" "MGM"
##
## $`13`
## [1] "MOB"
print(blockmodel(airports.geo.stat,airports.geo.eigen$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7 Block 8
## Block 1 0.299 0.138 0.094 0.104 0.029 0.125 0.088 0.118
## Block 2 0.137 0.227 0.099 0.056 0.028 0.077 0.099 0.056
## Block 3 0.088 0.097 0.153 0.042 0.000 0.017 0.000 0.034
## Block 4 0.107 0.062 0.037 0.137 0.000 0.000 0.000 0.000
## Block 5 0.044 0.028 0.000 0.000 NaN 0.000 0.000 0.000
## Block 6 0.118 0.077 0.017 0.000 0.000 0.500 0.000 0.000
## Block 7 0.088 0.099 0.000 0.000 0.000 0.000 NaN 0.000
## Block 8 0.103 0.056 0.000 0.000 0.000 0.000 0.000 NaN
## Block 9 0.103 0.056 0.000 0.000 0.000 0.000 0.000 0.000
## Block 10 0.118 0.042 0.103 0.000 0.000 0.000 0.000 0.000
## Block 11 0.059 0.014 0.034 0.000 0.000 0.000 0.000 0.000
## Block 12 0.029 0.035 0.000 0.000 0.000 0.000 0.000 0.000
## Block 13 0.044 0.042 0.000 0.000 0.000 0.000 0.000 0.000
## Block 9 Block 10 Block 11 Block 12 Block 13
## Block 1 0.103 0.118 0.074 0.037 0.029
## Block 2 0.056 0.042 0.014 0.035 0.042
## Block 3 0.000 0.069 0.034 0.000 0.000
## Block 4 0.000 0.000 0.000 0.000 0.000
## Block 5 0.000 0.000 0.000 0.000 0.000
## Block 6 0.000 0.000 0.000 0.000 0.000
## Block 7 0.000 0.000 0.000 0.000 0.000
## Block 8 0.000 0.000 0.000 0.000 0.000
## Block 9 NaN 0.000 0.000 0.000 0.000
## Block 10 0.000 NaN 0.000 0.000 0.000
## Block 11 0.000 0.000 NaN 0.000 0.000
## Block 12 0.000 0.000 0.000 0.000 0.000
## Block 13 0.000 0.000 0.000 0.000 NaN
airports.geo.nodes$comm.eigen<-airports.geo.eigen$membership
nodes.by.gp(airports.geo.nodes,"comm.eigen")
## comm.eigen degree degree.wt betweenness close eigen eigen.rc
## [1,] 1 69.5 52107 169.018 0.53 0.074 0.00118
## [2,] 2 59.0 58715 314.028 0.51 0.053 0.00101
## [3,] 3 36.2 29868 95.152 0.49 0.036 0.00055
## [4,] 4 28.6 14818 25.055 0.48 0.034 0.00043
## [5,] 5 9.0 12059 0.134 0.43 0.012 0.00015
## [6,] 6 29.5 16814 1.301 0.49 0.041 0.00044
## [7,] 7 26.0 14292 0.037 0.50 0.041 0.00042
## [8,] 8 24.0 10867 0.349 0.46 0.031 0.00035
## [9,] 9 22.0 8738 0.000 0.48 0.034 0.00033
## [10,] 10 27.0 10732 27.401 0.49 0.028 0.00039
## [11,] 11 13.0 8121 4.013 0.44 0.013 0.00018
## [12,] 12 9.5 3353 0.036 0.46 0.013 0.00012
## [13,] 13 11.0 4353 0.000 0.46 0.018 0.00016
## eigen.dc comm.fg comm.wt comm.lab n
## [1,] 0.072 3.1 2.9 2.9 68
## [2,] 0.052 2.5 1.6 1.6 71
## [3,] 0.036 1.9 2.3 2.3 29
## [4,] 0.033 2.0 2.9 2.9 14
## [5,] 0.012 3.0 3.0 3.0 1
## [6,] 0.041 2.0 3.0 3.0 2
## [7,] 0.041 2.0 3.0 3.0 1
## [8,] 0.030 4.0 3.0 3.0 1
## [9,] 0.034 2.0 3.0 3.0 1
## [10,] 0.028 1.0 2.0 2.0 1
## [11,] 0.013 1.0 3.0 3.0 1
## [12,] 0.013 2.0 3.0 3.0 2
## [13,] 0.018 2.0 3.0 3.0 1
plot(airports.geo.eigen,airports.geo.ig)
airports.geo.mods<-c(airports.geo.mods, eigen=modularity(airports.geo.eigen))
airports.geo.mods
## fastgreedy walktrap label eigen
## 0.152647769 0.081461683 0.081461683 0.008841226 0.132404946
compare.algs(alg.a=c("airports.geo.fg","airports.geo.wt", "airports.geo.lab", "airports.edge"), alg.b="airports.geo.eigen")
## alg.a alg.b meth result
## 1 airports.geo.fg airports.geo.eigen vi 1.84616889
## 2 airports.geo.wt airports.geo.eigen vi 1.68521285
## 3 airports.geo.lab airports.geo.eigen vi 1.68521285
## 4 airports.edge airports.geo.eigen vi 2.68427480
## 5 airports.geo.fg airports.geo.eigen nmi 0.35940149
## 6 airports.geo.wt airports.geo.eigen nmi 0.26936136
## 7 airports.geo.lab airports.geo.eigen nmi 0.26936136
## 8 airports.edge airports.geo.eigen nmi 0.35941692
## 9 airports.geo.fg airports.geo.eigen split.join 140.00000000
## 10 airports.geo.wt airports.geo.eigen split.join 111.00000000
## 11 airports.geo.lab airports.geo.eigen split.join 111.00000000
## 12 airports.edge airports.geo.eigen split.join 139.00000000
## 13 airports.geo.fg airports.geo.eigen rand 0.71599741
## 14 airports.geo.wt airports.geo.eigen rand 0.61210060
## 15 airports.geo.lab airports.geo.eigen rand 0.61210060
## 16 airports.edge airports.geo.eigen rand 0.60913212
## 17 airports.geo.fg airports.geo.eigen adjusted.rand 0.27256383
## 18 airports.geo.wt airports.geo.eigen adjusted.rand 0.22769455
## 19 airports.geo.lab airports.geo.eigen adjusted.rand 0.22769455
## 20 airports.edge airports.geo.eigen adjusted.rand 0.05536869
If we ran this algoritm on our entire network, we would get an error. This algorithm doesn’t work with a disconnected graphs! Let’s run it on a connected component subgraph. We first need to create a custom function to extract the giant component.
giant.component <- function(graph) {
cl <- clusters(graph)
induced.subgraph(graph, which(cl$membership == which.max(cl$csize)))
}
#extract giant component
flomarr.giant<-giant.component(flomarr.ig)
#Run clustering algorithm: spinglass
comm.spin<-spinglass.community(flomarr.giant)
#Inspect community membership
igraph::groups(comm.spin)
## $`1`
## [1] "Acciaiuoli" "Barbadori" "Medici" "Ridolfi" "Tornabuoni"
##
## $`2`
## [1] "Pazzi" "Salviati"
##
## $`3`
## [1] "Albizzi" "Ginori" "Guadagni" "Lamberteschi"
##
## $`4`
## [1] "Bischeri" "Castellani" "Peruzzi" "Strozzi"
We can describe and plot the spinglass communities. Note the changes to the line adding community membership as a vertex attribute. The which() statement omits the nodes that are not part of the giant component when matching the community membership vector. Not including this alteration will produce an error due to different vector lengths.
#inspect density of between/within community ties
print(blockmodel(flomarr.stat,comm.spin$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4
## Block 1 0.200 0.25 0.083 0.208
## Block 2 0.250 0.00 0.000 0.125
## Block 3 0.083 0.00 0.500 0.062
## Block 4 0.208 0.12 0.062 0.333
#add community membership as a vertex attribute
flomarr.nodes$comm.spin[which(flomarr.nodes$name%in%V(flomarr.giant)$name)]<-comm.spin$membership
#summarize node statistics by community
nodes.by.gp(flomarr.nodes,"comm.spin")
## comm.spin degree betweenness close constraint eigen eigen.rc eigen.dc
## [1,] 1 3.0 14.9 0 0.53 0.288 0.082 0.207
## [2,] 2 1.5 6.5 0 0.75 0.095 0.032 0.063
## [3,] 3 2.2 10.6 0 0.65 0.174 0.057 0.117
## [4,] 4 3.2 6.5 0 0.52 0.293 0.091 0.202
## [5,] NA 0.0 0.0 0 0.00 0.000 NaN NaN
## comm.fg comm.wt comm.lab comm.edge comm.eigen n
## [1,] 1.4 2.2 1.2 1.2 1.6 5
## [2,] 1.0 4.0 1.0 1.0 1.0 2
## [3,] 2.0 1.0 1.0 1.0 4.0 4
## [4,] 3.0 3.0 2.0 2.0 3.0 4
## [5,] 4.0 5.0 3.0 3.0 2.0 1
#plot network with community coloring
plot(comm.spin,flomarr.ig)
Compare the various community partitions created so far. Because the original network was not connected and we had to extract a giant component, comparing the partitions using our custom compare.alg function would require additional steps to make the partitions comparable (i.e., have the same number of nodes.) This is not done in this tutorial, but could be done if required.
#collect modularity scores to compare
mods<-c(mods, eigen=modularity(comm.spin))
mods
## fastgreedy walktrap label edge eigen eigen
## 0.4410431 0.3922902 0.3730159 0.3730159 0.4070295 0.3975000
#compare community partitions - not connected
Repeat the basic community analysis routine for one of the other datasets provided this week.
#Run clustering algorithm: spinglass
#Inspect community membership
#inspect density of between/within community ties
#add community membership as a vertex attribute
#summarize node statistics by community
#plot the network with community coloring
#compare modularity scores
#compare community partitions (only if connected)
#Run clustering algorithm: spinglass
got.spin<-spinglass.community(gotmarr.ig)
#Inspect community membership
igraph::groups(got.spin)
## $`1`
## [1] "Martell" "Crownlands" "Essos" "Targaryen" "Dorne"
##
## $`2`
## [1] "Baratheon" "Reach" "Tyrell"
##
## $`3`
## [1] "Arryn" "Tully" "Vale" "Stormlands" "Riverlands"
## [6] "Frey"
##
## $`4`
## [1] "Lannister" "Westerlands"
##
## $`5`
## [1] "Stark" "North"
#inspect density of between/within community ties
print(blockmodel(gotmarr.stat,got.spin$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.60 0.20 0.23 0.20 0.20
## Block 2 0.20 1.00 0.22 0.50 0.33
## Block 3 0.23 0.22 0.53 0.17 0.33
## Block 4 0.20 0.50 0.17 1.00 0.50
## Block 5 0.20 0.33 0.33 0.50 1.00
#add community membership as a vertex attribute
gotmarr.nodes$comm.spin<-got.spin$membership
#summarize node statistics by community
nodes.by.gp(gotmarr.nodes,"comm.spin")
## comm.spin degree degree.wt bonpow betweenness close constraint eigen
## [1,] 1 5.2 22 -0.79 9.3 0.57 0.62 0.20
## [2,] 2 6.0 22 -0.96 8.9 0.59 0.45 0.22
## [3,] 3 5.5 23 -1.31 4.5 0.58 0.41 0.22
## [4,] 4 5.5 25 -0.15 1.4 0.58 0.57 0.25
## [5,] 5 6.0 36 -0.29 6.9 0.59 0.53 0.24
## eigen.rc eigen.dc comm.fg comm.wt comm.lab comm.edge comm.eigen n
## [1,] 0.041 0.16 2.0 2 2 12.8 1.0 5
## [2,] 0.039 0.18 3.0 3 3 7.0 3.3 3
## [3,] 0.047 0.17 2.5 1 1 7.2 1.7 6
## [4,] 0.095 0.16 5.0 5 5 9.5 5.0 2
## [5,] 0.114 0.12 6.0 4 4 12.0 4.0 2
#plot the network with community coloring
plot(got.spin,gotmarr.ig)
#collect modularity scores to compare
got.mods<-c(got.mods, spin=modularity(got.spin))
got.mods
## fastgreedy walktrap label edge eigen spin
## 0.5173683 0.3289444 0.3289444 0.2051354 0.4572361 0.0744876
#compare community partitions
compare.algs(alg.a=c("got.fg","got.wt", "got.lab", "got.edge", "got.eigen"), alg.b="got.spin")
## alg.a alg.b meth result
## 1 got.fg got.spin vi 0.2310491
## 2 got.wt got.spin vi 0.0000000
## 3 got.lab got.spin vi 0.0000000
## 4 got.edge got.spin vi 1.3814540
## 5 got.eigen got.spin vi 0.7953872
## 6 got.fg got.spin nmi 0.9288836
## 7 got.wt got.spin nmi 1.0000000
## 8 got.lab got.spin nmi 1.0000000
## 9 got.edge got.spin nmi 0.6859825
## 10 got.eigen got.spin nmi 0.7360144
## 11 got.fg got.spin split.join 3.0000000
## 12 got.wt got.spin split.join 0.0000000
## 13 got.lab got.spin split.join 0.0000000
## 14 got.edge got.spin split.join 13.0000000
## 15 got.eigen got.spin split.join 7.0000000
## 16 got.fg got.spin rand 0.9411765
## 17 got.wt got.spin rand 1.0000000
## 18 got.lab got.spin rand 1.0000000
## 19 got.edge got.spin rand 0.8039216
## 20 got.eigen got.spin rand 0.8169935
## 21 got.fg got.spin adjusted.rand 0.7895461
## 22 got.wt got.spin adjusted.rand 1.0000000
## 23 got.lab got.spin adjusted.rand 1.0000000
## 24 got.edge got.spin adjusted.rand 0.0000000
## 25 got.eigen got.spin adjusted.rand 0.4603175
#alliances
#extract giant component
alliances.giant<-giant.component(alliances.ig)
alliances.spin<-spinglass.community(alliances.giant)
igraph::groups(alliances.spin)
## $`1`
## [1] "Central African Republic" "Chad"
## [3] "Cameroon" "Gabon"
## [5] "Congo" "Rwanda"
## [7] "Kenya" "Democratic Republic of the Congo"
## [9] "Burundi" "Uganda"
## [11] "Angola" "Ethiopia"
## [13] "Sao Tome and Principe" "Equatorial Guinea"
## [15] "Tanzania" "Zambia"
## [17] "Eritrea"
##
## $`2`
## [1] "Saudi Arabia" "Iraq" "Mauritania"
## [4] "Somalia" "Djibouti" "Morocco"
## [7] "Algeria" "Tunisia" "Libya"
## [10] "Sudan" "Egypt" "Syria"
## [13] "Lebanon" "Jordan" "Yemen"
## [16] "Kuwait" "Bahrain" "Qatar"
## [19] "United Arab Emirates" "Oman" "Israel"
##
## $`3`
## [1] "Paraguay" "Brazil"
## [3] "Ecuador" "Peru"
## [5] "Colombia" "Argentina"
## [7] "Bolivia" "Guatemala"
## [9] "Honduras" "El Salvador"
## [11] "Nicaragua" "United States of America"
## [13] "Haiti" "Dominican Republic"
## [15] "Mexico" "Costa Rica"
## [17] "Panama" "Venezuela"
## [19] "Chile" "Japan"
## [21] "Australia" "Canada"
## [23] "Bahamas" "Jamaica"
## [25] "Trinidad and Tobago" "Barbados"
## [27] "Dominica" "Grenada"
## [29] "St. Lucia" "St. Vincent and the Grenadines"
## [31] "Antigua & Barbuda" "St. Kitts and Nevis"
## [33] "Belize" "Guyana"
## [35] "Suriname" "Philippines"
## [37] "Uruguay"
##
## $`4`
## [1] "Russia" "Iran" "Latvia" "Pakistan"
## [5] "China" "Afghanistan" "India" "North Korea"
## [9] "Moldova" "Ukraine" "Belarus" "Armenia"
## [13] "Georgia" "Azerbaijan" "Turkmenistan" "Tajikistan"
## [17] "Kyrgyzstan" "Uzbekistan" "Lithuania" "Kazakhstan"
## [21] "Finland" "Mongolia" "South Korea"
##
## $`5`
## [1] "Mali" "Guinea" "Senegal" "Benin"
## [5] "Niger" "Ivory Coast" "Burkina Faso" "Togo"
## [9] "Cape Verde" "Guinea-Bissau" "Gambia" "Liberia"
## [13] "Sierra Leone" "Ghana" "Nigeria"
##
## $`6`
## [1] "United Kingdom" "Germany"
## [3] "Netherlands" "France"
## [5] "Belgium" "Italy"
## [7] "Spain" "Greece"
## [9] "Bulgaria" "Romania"
## [11] "Turkey" "Poland"
## [13] "Estonia" "Hungary"
## [15] "Albania" "Luxembourg"
## [17] "Portugal" "German Federal Republic"
## [19] "Czech Republic" "Norway"
## [21] "Denmark" "Iceland"
## [23] "Slovakia"
##
## $`7`
## [1] "Yugoslavia" "Croatia"
## [3] "Bosnia and Herzegovina"
print(blockmodel(alliances.stat,alliances.spin$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6 Block 7
## Block 1 0.5662 0.0280 0.0143 0.031 0.0000 0.0047 0.020
## Block 2 0.0280 0.8143 0.0026 0.046 0.0063 0.0000 0.000
## Block 3 0.0143 0.0026 0.7973 0.041 0.0018 0.0368 0.000
## Block 4 0.0307 0.0455 0.0411 0.281 0.0000 0.0296 0.232
## Block 5 0.0000 0.0063 0.0018 0.000 0.8667 0.0000 0.311
## Block 6 0.0047 0.0000 0.0368 0.030 0.0000 0.5167 0.027
## Block 7 0.0196 0.0000 0.0000 0.232 0.3111 0.0267 0.000
alliances.nodes$comm.spin[which(alliances.nodes$name%in%V(alliances.giant)$name)]<-alliances.spin$membership
nodes.by.gp(alliances.nodes,"comm.spin")
## comm.spin degree degree.wt betweenness close constraint eigen
## [1,] 1 21.9 12.9 381 0.3337 0.34 5.8e-05
## [2,] 2 37.7 34.3 250 0.3467 0.22 1.8e-06
## [3,] 3 63.0 33.6 282 0.4780 0.19 1.6e-01
## [4,] 4 19.0 15.0 449 0.3754 0.39 1.5e-03
## [5,] 5 28.1 14.2 231 0.3398 0.26 6.3e-04
## [6,] 6 31.6 19.2 323 0.4334 0.25 1.6e-02
## [7,] 7 4.7 2.3 181 0.2741 0.88 2.3e-04
## [8,] NA 2.0 1.0 0 0.0071 1.00 7.5e-64
## eigen.rc eigen.dc comm.fg comm.wt comm.lab comm.edge comm.eigen n
## [1,] 4.2e-06 5.3e-05 1.0 5.5 5.5 11.2 1 17
## [2,] 9.5e-08 1.7e-06 5.8 7.0 7.0 7.0 1 21
## [3,] 4.7e-03 1.5e-01 7.3 4.0 4.0 3.5 1 37
## [4,] 9.7e-05 1.4e-03 2.0 1.0 1.0 3.1 1 23
## [5,] 4.1e-05 5.9e-04 7.0 8.0 8.0 12.0 1 15
## [6,] 7.4e-04 1.6e-02 2.8 3.0 3.0 1.8 1 23
## [7,] 2.9e-05 2.0e-04 4.0 5.0 5.0 4.0 1 3
## [8,] 7.5e-64 0.0e+00 5.0 9.0 9.0 14.0 2 2
plot(alliances.spin,alliances.ig)
alliances.mods<-c(alliances.mods, spin=modularity(alliances.spin))
alliances.mods
## fastgreedy walktrap label edge eigen spin
## 0.699295231 0.713057101 0.713057101 0.708393203 0.001252348 0.581031240
#airport flights
airports.fl.spin<-spinglass.community(airports.fl.ig)
igraph::groups(airports.fl.spin)
## $`1`
## [1] "AMA" "AUS" "BHM" "BTR" "CRP" "DAL" "DFW" "ELP" "GPT" "GRK" "HOU"
## [12] "HRL" "IAH" "ICT" "JAN" "LBB" "LFT" "LIT" "MAF" "MEM" "MFE" "MOB"
## [23] "MSY" "OKC" "PNS" "SAT" "SGF" "SHV" "TUL" "VPS" "XNA"
##
## $`2`
## [1] "HNL" "ITO" "KOA" "LIH" "OGG"
##
## $`3`
## [1] "SJU" "STT" "STX"
##
## $`4`
## [1] "ABE" "ACY" "AGS" "ALB" "ATL" "AVL" "AVP" "BDL" "BGR" "BMI" "BNA"
## [12] "BOS" "BQN" "BTV" "BUF" "BWI" "CAE" "CAK" "CHA" "CHO" "CHS" "CLE"
## [23] "CLT" "CMH" "CRW" "DAB" "DAY" "DCA" "DTW" "ECP" "ELM" "EWR" "EYW"
## [34] "FAY" "FLL" "FNT" "GNV" "GSO" "GSP" "HPN" "HSV" "IAD" "ILM" "IND"
## [45] "ISP" "JAX" "JFK" "LEX" "LGA" "MCO" "MDT" "MDW" "MGM" "MHT" "MIA"
## [56] "MLB" "MYR" "OAJ" "ORF" "PBI" "PGD" "PHF" "PHL" "PIT" "PVD" "PWM"
## [67] "RDU" "RIC" "ROA" "ROC" "RSW" "SAV" "SCE" "SDF" "SRQ" "SWF" "SYR"
## [78] "TLH" "TPA" "TRI" "TYS"
##
## $`5`
## [1] "ATW" "AZO" "BIS" "CID" "CVG" "DSM" "EVV" "FAR" "FSD" "FWA" "GRB"
## [12] "GRR" "MCI" "MKE" "MLI" "MSN" "MSP" "OMA" "ORD" "PIA" "PIE" "SBN"
## [23] "SFB" "STL"
##
## $`6`
## [1] "ABQ" "ANC" "ASE" "AZA" "BET" "BIL" "BLI" "BOI" "BUR" "BZN" "COS"
## [12] "DEN" "DRO" "EGE" "EUG" "FAI" "FAT" "GEG" "GJT" "GTF" "GUM" "IDA"
## [23] "JAC" "JNU" "KTN" "LAS" "LAX" "LGB" "MFR" "MRY" "MSO" "OAK" "ONT"
## [34] "PDX" "PHX" "PSC" "PSP" "RAP" "RDM" "RNO" "SAN" "SBA" "SEA" "SFO"
## [45] "SJC" "SLC" "SMF" "SNA" "TUS"
print(blockmodel(airports.fl.stat,airports.fl.spin$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5 Block 6
## Block 1 0.266 0.0194 0.0215 0.1119 0.124 0.1020
## Block 2 0.019 0.7500 0.0000 0.0074 0.033 0.1796
## Block 3 0.022 0.0000 1.0000 0.1152 0.028 0.0068
## Block 4 0.113 0.0074 0.1111 0.2502 0.157 0.0574
## Block 5 0.122 0.0250 0.0556 0.1564 0.292 0.1216
## Block 6 0.096 0.1878 0.0068 0.0569 0.123 0.2815
airports.fl.nodes$comm.spin<-airports.fl.spin$membership
nodes.by.gp(airports.fl.nodes,"comm.spin")
## comm.spin degree degree.wt betweenness close constraint eigen
## [1,] 1 50 5579 165.6 0.51 0.21 0.052
## [2,] 2 28 3959 130.1 0.46 0.60 0.027
## [3,] 3 26 3210 9.4 0.48 0.50 0.033
## [4,] 4 61 6989 191.7 0.52 0.20 0.064
## [5,] 5 59 6189 219.6 0.52 0.19 0.058
## [6,] 6 50 6299 210.7 0.49 0.30 0.045
## eigen.rc eigen.dc comm.fg comm.wt comm.lab comm.eigen n
## [1,] 0.00083 0.051 5.0 3.7 3.7 2.5 31
## [2,] 0.00044 0.026 2.0 4.0 4.0 2.0 5
## [3,] 0.00043 0.033 6.0 3.0 3.0 1.0 3
## [4,] 0.00104 0.063 3.0 5.0 5.0 1.5 81
## [5,] 0.00099 0.057 3.5 4.6 4.6 1.3 24
## [6,] 0.00082 0.044 1.0 1.9 1.9 2.0 49
plot(airports.fl.spin,airports.fl.ig)
airports.fl.mods<-c(airports.fl.mods, spin=modularity(airports.fl.spin))
airports.fl.mods
## fastgreedy walktrap label eigen spin
## 0.285292426 0.246254131 0.246254131 0.008841226 0.245978519 0.002393383
compare.algs(alg.a=c("airports.fl.fg","airports.fl.wt", "airports.fl.lab", "airports.edge", "airports.fl.eigen"), alg.b="airports.fl.spin")
## alg.a alg.b meth result
## 1 airports.fl.fg airports.fl.spin vi 0.49260276
## 2 airports.fl.wt airports.fl.spin vi 1.02869799
## 3 airports.fl.lab airports.fl.spin vi 1.02869799
## 4 airports.edge airports.fl.spin vi 2.74128462
## 5 airports.fl.eigen airports.fl.spin vi 1.33357990
## 6 airports.fl.fg airports.fl.spin nmi 0.82205753
## 7 airports.fl.wt airports.fl.spin nmi 0.56221912
## 8 airports.fl.lab airports.fl.spin nmi 0.56221912
## 9 airports.edge airports.fl.spin nmi 0.33447902
## 10 airports.fl.eigen airports.fl.spin nmi 0.46169094
## 11 airports.fl.fg airports.fl.spin split.join 33.00000000
## 12 airports.fl.wt airports.fl.spin split.join 78.00000000
## 13 airports.fl.lab airports.fl.spin split.join 78.00000000
## 14 airports.edge airports.fl.spin split.join 141.00000000
## 15 airports.fl.eigen airports.fl.spin split.join 108.00000000
## 16 airports.fl.fg airports.fl.spin rand 0.91693653
## 17 airports.fl.wt airports.fl.spin rand 0.73936744
## 18 airports.fl.lab airports.fl.spin rand 0.73936744
## 19 airports.edge airports.fl.spin rand 0.60967185
## 20 airports.fl.eigen airports.fl.spin rand 0.73737047
## 21 airports.fl.fg airports.fl.spin adjusted.rand 0.80133909
## 22 airports.fl.wt airports.fl.spin adjusted.rand 0.46898229
## 23 airports.fl.lab airports.fl.spin adjusted.rand 0.46898229
## 24 airports.edge airports.fl.spin adjusted.rand 0.05213253
## 25 airports.fl.eigen airports.fl.spin adjusted.rand 0.39938793
#airport geography
airports.geo.spin<-spinglass.community(airports.geo.ig)
igraph::groups(airports.geo.spin)
## $`1`
## [1] "ABQ" "ANC" "ATL" "AUS" "BET" "BLI" "BUR" "BZN" "CHO" "COS" "EWR"
## [12] "FAI" "HNL" "IAD" "ITO" "JAC" "JFK" "JNU" "KOA" "KTN" "LBB" "LGB"
## [23] "MAF" "MDW" "MRY" "MSP" "OAJ" "OAK" "OGG" "OKC" "ONT" "ORD" "PDX"
## [34] "PSP" "RAP" "SAN" "SAT" "SEA" "SJC" "SLC" "SMF" "SNA" "STT" "TUS"
##
## $`2`
## [1] "ACY" "ALB" "AVP" "BDL" "BHM" "BNA" "BOS" "BQN" "BTV" "BUF" "BWI"
## [12] "CAK" "CLE" "CLT" "CMH" "CVG" "DAB" "DCA" "ECP" "EYW" "FLL" "FNT"
## [23] "GNV" "GPT" "GRB" "GRR" "HOU" "HPN" "IND" "ISP" "JAX" "LAS" "MCI"
## [34] "MCO" "MEM" "MHT" "MKE" "MLB" "MSY" "MYR" "ORF" "PBI" "PHL" "PHX"
## [45] "PVD" "RDU" "RIC" "ROC" "RSW" "SCE" "SDF" "SHV" "SJU" "SRQ" "SWF"
## [56] "SYR" "TLH" "TPA"
##
## $`3`
## [1] "ATW" "AZA" "BGR" "BIL" "BIS" "BOI" "CID" "DEN" "DRO" "DSM" "ELM"
## [12] "EUG" "FAR" "FAT" "FSD" "FWA" "GEG" "GTF" "IDA" "MFE" "MFR" "MLI"
## [23] "MSN" "MSO" "PIA" "PIE" "PSC" "RDM" "ROA" "SBA" "SBN" "SFB" "SGF"
## [34] "TRI" "XNA"
##
## $`4`
## [1] "ABE" "AMA" "ASE" "BTR" "DAL" "ELP" "GJT" "GUM" "HRL" "LAX" "LIH"
## [12] "LIT" "MDT" "MIA" "OMA" "PIT" "RNO" "SFO" "STL" "STX" "TUL"
##
## $`5`
## [1] "AGS" "AVL" "AZO" "BMI" "CAE" "CHA" "CHS" "CRP" "CRW" "DAY" "DFW"
## [12] "DTW" "EGE" "EVV" "FAY" "GRK" "GSO" "GSP" "HSV" "IAH" "ICT" "ILM"
## [23] "JAN" "LEX" "LFT" "LGA" "MGM" "MOB" "PGD" "PHF" "PNS" "PWM" "SAV"
## [34] "TYS" "VPS"
print(blockmodel(airports.geo.stat,airports.geo.spin$membership)$block.model, digits=2)
## Block 1 Block 2 Block 3 Block 4 Block 5
## Block 1 0.297 0.160 0.097 0.187 0.100
## Block 2 0.163 0.315 0.058 0.154 0.136
## Block 3 0.093 0.057 0.134 0.064 0.045
## Block 4 0.173 0.144 0.065 0.217 0.079
## Block 5 0.101 0.134 0.051 0.084 0.165
airports.geo.nodes$comm.spin<-airports.geo.spin$membership
nodes.by.gp(airports.geo.nodes,"comm.spin")
## comm.spin degree degree.wt betweenness close eigen eigen.rc eigen.dc
## [1,] 1 66 66714 338 0.52 0.060 0.00112 0.059
## [2,] 2 70 54221 178 0.53 0.074 0.00120 0.073
## [3,] 3 30 22517 87 0.48 0.028 0.00046 0.028
## [4,] 4 52 49438 118 0.51 0.053 0.00080 0.052
## [5,] 5 43 28244 176 0.50 0.044 0.00073 0.043
## comm.fg comm.wt comm.lab comm.eigen n
## [1,] 2.8 1.7 1.7 2.0 44
## [2,] 3.3 2.9 2.9 1.6 58
## [3,] 1.4 1.8 1.8 3.0 35
## [4,] 2.8 2.0 2.0 1.4 21
## [5,] 1.9 2.9 2.9 3.9 35
plot(airports.geo.spin,airports.geo.ig)
airports.geo.mods<-c(airports.geo.mods, spin=modularity(airports.geo.spin))
airports.geo.mods
## fastgreedy walktrap label eigen spin
## 0.152647769 0.081461683 0.081461683 0.008841226 0.132404946 0.000253963
compare.algs(alg.a=c("airports.geo.fg","airports.geo.wt", "airports.geo.lab", "airports.edge", "airports.geo.eigen"), alg.b="airports.geo.spin")
## alg.a alg.b meth result
## 1 airports.geo.fg airports.geo.spin vi 1.50484573
## 2 airports.geo.wt airports.geo.spin vi 1.75693629
## 3 airports.geo.lab airports.geo.spin vi 1.75693629
## 4 airports.edge airports.geo.spin vi 2.72739662
## 5 airports.geo.eigen airports.geo.spin vi 1.83838904
## 6 airports.geo.fg airports.geo.spin nmi 0.48897946
## 7 airports.geo.wt airports.geo.spin nmi 0.25846839
## 8 airports.geo.lab airports.geo.spin nmi 0.25846839
## 9 airports.edge airports.geo.spin nmi 0.35874292
## 10 airports.geo.eigen airports.geo.spin nmi 0.39825260
## 11 airports.geo.fg airports.geo.spin split.join 100.00000000
## 12 airports.geo.wt airports.geo.spin split.join 145.00000000
## 13 airports.geo.lab airports.geo.spin split.join 145.00000000
## 14 airports.edge airports.geo.spin split.join 151.00000000
## 15 airports.geo.eigen airports.geo.spin split.join 130.00000000
## 16 airports.geo.fg airports.geo.spin rand 0.81039508
## 17 airports.geo.wt airports.geo.spin rand 0.59261658
## 18 airports.geo.lab airports.geo.spin rand 0.59261658
## 19 airports.edge airports.geo.spin rand 0.63908679
## 20 airports.geo.eigen airports.geo.spin rand 0.74843480
## 21 airports.geo.fg airports.geo.spin adjusted.rand 0.46715031
## 22 airports.geo.wt airports.geo.spin adjusted.rand 0.19005297
## 23 airports.geo.lab airports.geo.spin adjusted.rand 0.19005297
## 24 airports.edge airports.geo.spin adjusted.rand 0.06636388
## 25 airports.geo.eigen airports.geo.spin adjusted.rand 0.33314708